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

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

Add new openMP parallelism based on distribution of domains on threads. There is no more limitation of number of threads by MPI process.

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  IMPLICIT NONE
33    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
34    REAL(rstd),INTENT(OUT) :: Ki(iim*jjm,llm)
35    INTEGER :: i,j,ij,l
36   
37    DO l=1,llm
38      DO j=jj_begin,jj_end
39        DO i=ii_begin,ii_end
40          ij=(j-1)*iim+i
41
42          Ki(ij,l)=1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*ue(ij+u_right,l)**2 +  &
43                               le(ij+u_rup)*de(ij+u_rup)*ue(ij+u_rup,l)**2 +        &
44                               le(ij+u_lup)*de(ij+u_lup)*ue(ij+u_lup,l)**2 +        &
45                               le(ij+u_left)*de(ij+u_left)*ue(ij+u_left,l)**2 +     &
46                               le(ij+u_ldown)*de(ij+u_ldown)*ue(ij+u_ldown,l)**2 +  &
47                               le(ij+u_rdown)*de(ij+u_rdown)*ue(ij+u_rdown,l)**2 ) 
48       
49        ENDDO
50      ENDDO
51    ENDDO
52   
53 
54  END SUBROUTINE compute_kinetic
55       
56END MODULE kinetic_mod
Note: See TracBrowser for help on using the repository browser.