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

Last change on this file since 78 was 19, checked in by ymipsl, 12 years ago

Simplify the management of the module.

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)
17    CALL transfert_request(f_ue,req_e1)
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.