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

Last change on this file since 295 was 295, checked in by ymipsl, 10 years ago

Merging OpenMP parallisme mode : by subdomain and on vertical level.
This feature is actually experimental but may be retro-compatible with the last method based only on subdomain

YM
File size: 1.5 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      IF (.NOT. assigned_domain(ind)) CYCLE
21      CALL swap_dimensions(ind)
22      CALL swap_geometry(ind)
23      ue=f_ue(ind)
24      Ki=f_Ki(ind)
25      CALL compute_kinetic(ue, Ki)
26    ENDDO
27 
28  END SUBROUTINE kinetic
29 
30  SUBROUTINE compute_kinetic(ue, Ki)
31  USE icosa
32  USE omp_para
33  IMPLICIT NONE
34    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
35    REAL(rstd),INTENT(OUT) :: Ki(iim*jjm,llm)
36    INTEGER :: i,j,ij,l
37   
38    DO l=ll_begin,ll_end
39      DO j=jj_begin,jj_end
40        DO i=ii_begin,ii_end
41          ij=(j-1)*iim+i
42
43          Ki(ij,l)=1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*ue(ij+u_right,l)**2 +  &
44                               le(ij+u_rup)*de(ij+u_rup)*ue(ij+u_rup,l)**2 +        &
45                               le(ij+u_lup)*de(ij+u_lup)*ue(ij+u_lup,l)**2 +        &
46                               le(ij+u_left)*de(ij+u_left)*ue(ij+u_left,l)**2 +     &
47                               le(ij+u_ldown)*de(ij+u_ldown)*ue(ij+u_ldown,l)**2 +  &
48                               le(ij+u_rdown)*de(ij+u_rdown)*ue(ij+u_rdown,l)**2 ) 
49       
50        ENDDO
51      ENDDO
52    ENDDO
53   
54 
55  END SUBROUTINE compute_kinetic
56       
57END MODULE kinetic_mod
Note: See TracBrowser for help on using the repository browser.