source: codes/icosagcm/trunk/src/kinetic.f90 @ 178

Last change on this file since 178 was 146, checked in by ymipsl, 11 years ago

Set constant sign for wind way :
ne(ij,right)==ne_right=1
ne(ij,rup)==ne_rup=-1
ne(ij,lup)==ne_lup=1
ne(ij,left)==ne_left=-1
ne(ij,ldown)==ne_ldown=1
ne(ij,rdown)==ne_rdown=-1

Modified transfert function to be compliant for this convention.

YM
File size: 1.4 KB
Line 
1MODULE kinetic_mod
2
3
4CONTAINS
5 
6  SUBROUTINE kinetic(f_ue,f_Ki)
7  USE icosa
8  IMPLICIT NONE
9    TYPE(t_field), POINTER :: f_ue(:)
10    TYPE(t_field), POINTER :: f_Ki(:)
11 
12    REAL(rstd), POINTER :: ue(:,:)
13    REAL(rstd), POINTER :: Ki(:,:)
14    INTEGER :: ind
15 
16    CALL transfert_request(f_ue,req_e1_vect)
17    CALL transfert_request(f_ue,req_e1_vect)
18
19    DO ind=1,ndomain
20      CALL swap_dimensions(ind)
21      CALL swap_geometry(ind)
22      ue=f_ue(ind)
23      Ki=f_Ki(ind)
24      CALL compute_kinetic(ue, Ki)
25    ENDDO
26 
27  END SUBROUTINE kinetic
28 
29  SUBROUTINE compute_kinetic(ue, Ki)
30  USE icosa
31  IMPLICIT NONE
32    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
33    REAL(rstd),INTENT(OUT) :: Ki(iim*jjm,llm)
34    INTEGER :: i,j,ij,l
35   
36    DO l=1,llm
37      DO j=jj_begin,jj_end
38        DO i=ii_begin,ii_end
39          ij=(j-1)*iim+i
40
41          Ki(ij,l)=1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*ue(ij+u_right,l)**2 +  &
42                               le(ij+u_rup)*de(ij+u_rup)*ue(ij+u_rup,l)**2 +        &
43                               le(ij+u_lup)*de(ij+u_lup)*ue(ij+u_lup,l)**2 +        &
44                               le(ij+u_left)*de(ij+u_left)*ue(ij+u_left,l)**2 +     &
45                               le(ij+u_ldown)*de(ij+u_ldown)*ue(ij+u_ldown,l)**2 +  &
46                               le(ij+u_rdown)*de(ij+u_rdown)*ue(ij+u_rdown,l)**2 ) 
47       
48        ENDDO
49      ENDDO
50    ENDDO
51   
52 
53  END SUBROUTINE compute_kinetic
54       
55END MODULE kinetic_mod
Note: See TracBrowser for help on using the repository browser.