Changeset 148 for codes/icosagcm/trunk/src/advect_tracer.f90

Timestamp:

03/18/13 15:44:08 (11 years ago)

Author:

ymipsl

Message:

Various optimisations

• dissipation is not called every timestep (similar way than LMDZ)
• transfert size of halos has been reduced : need to synchronise redondant data between tiles at itau_sync timestep

YM

File:

• codes/icosagcm/trunk/src/advect_tracer.f90 (modified) (19 diffs)

codes/icosagcm/trunk/src/advect_tracer.f90

@@ -8 +8 @@
   TYPE(t_field),POINTER :: f_gradq3d(:)
   TYPE(t_field),POINTER :: f_cc(:)  ! starting point of backward-trajectory (Miura approach)
-
+  TYPE(t_field),POINTER :: f_one_over_sqrt_leng(:)
+ 
   REAL(rstd), PARAMETER :: pente_max=2.0 ! for vlz
 
@@ -19 +20 @@
     REAL(rstd),POINTER :: tangent(:,:)
     REAL(rstd),POINTER :: normal(:,:)
+    REAL(rstd),POINTER :: one_over_sqrt_leng(:)
     INTEGER :: ind
 
@@ -25 +27 @@
     CALL allocate_field(f_gradq3d,field_t,type_real,llm,3, name='gradq3d')
     CALL allocate_field(f_cc,field_u,type_real,llm,3, name='cc')
+    CALL allocate_field(f_one_over_sqrt_leng,field_t,type_real, name='one_over_sqrt_leng')
 
     DO ind=1,ndomain
@@ -31 +34 @@
        normal=f_normal(ind)
        tangent=f_tangent(ind)
-       CALL init_advect(normal,tangent)
+       one_over_sqrt_leng=f_one_over_sqrt_leng(ind)
+       CALL init_advect(normal,tangent,one_over_sqrt_leng)
     END DO
 
@@ -49 +53 @@
     TYPE(t_field),POINTER :: f_rhodz(:)    ! mass field at beginning of macro time step
 
-    REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), gradq3d(:,:,:), cc(:,:,:)
+    REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), one_over_sqrt_leng(:), gradq3d(:,:,:), cc(:,:,:)
     REAL(rstd),POINTER :: hfluxt(:,:), wfluxt(:,:)
     REAL(rstd),POINTER :: rhodz(:,:), u(:,:) 
@@ -106 +110 @@
        rhodz   = f_rhodz(ind)
        wfluxt  = f_wfluxt(ind) 
+
        DO k = 1, nqtot
-          CALL vlz(k==nqtot,0.5, wfluxt,rhodz,q(:,:,k))
-       END DO
+          CALL vlz(k==nqtot,0.5, wfluxt,rhodz,q(:,:,k),1)
+       END DO
+
        CALL compute_backward_traj(tangent,normal,u,0.5*dt*itau_adv, cc) 
     END DO
 
-    CALL transfert_request(f_q,req_i1)      ! necessary ?
-    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
+!    CALL transfert_request(f_q,req_i1)      ! necessary ?
+!    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
 
     ! horizontal transport - split in two to place transfer of gradq3d
@@ -123 +129 @@
           q       = f_q(ind)
           gradq3d = f_gradq3d(ind)
-          CALL compute_gradq3d(q(:,:,k),gradq3d)
+          one_over_sqrt_leng=f_one_over_sqrt_leng(ind)
+          CALL compute_gradq3d(q(:,:,k),one_over_sqrt_leng,gradq3d)
        END DO
 
        CALL transfert_request(f_gradq3d,req_i1)
+
+
 
        DO ind=1,ndomain
@@ -140 +149 @@
     END DO 
     
-    CALL transfert_request(f_q,req_i1)      ! necessary ?
-    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
+!    CALL transfert_request(f_q,req_i1)      ! necessary ?
+!    CALL transfert_request(f_rhodz,req_i1)  ! necessary ?
     
     ! 1/2 vertical transport
@@ -151 +160 @@
        wfluxt  = f_wfluxt(ind) 
        DO k = 1,nqtot
-          CALL vlz(k==nqtot, 0.5,wfluxt,rhodz, q(:,:,k))
+          CALL vlz(k==nqtot, 0.5,wfluxt,rhodz, q(:,:,k),0)
        END DO
     END DO
@@ -159 +168 @@
   END SUBROUTINE advect_tracer
 
-  SUBROUTINE vlz(update_mass, fac,wfluxt,mass, q)
+  SUBROUTINE vlz(update_mass, fac,wfluxt,mass, q, halo)
     !
     !     Auteurs:   P.Le Van, F.Hourdin, F.Forget, T. Dubos
@@ -168 +177 @@
     !     wfluxt >0 for upward transport
     !    ********************************************************************
+    USE trace
     IMPLICIT NONE
     LOGICAL, INTENT(IN)       :: update_mass
@@ -173 +183 @@
     REAL(rstd), INTENT(INOUT) :: mass(iim*jjm,llm)
     REAL(rstd), INTENT(INOUT) :: q(iim*jjm,llm)
+    INTEGER, INTENT(IN) :: halo
 
     REAL(rstd) :: dq(iim*jjm,llm), & ! increase of q
@@ -182 +193 @@
     INTEGER :: i,ij,l,j
 
+    CALL trace_start("vlz")
+
     ! finite difference of q
     DO l=2,llm
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              dzqw(ij,l)=q(ij,l)-q(ij,l-1)
@@ -196 +209 @@
     ! dzq = slope*dz, i.e. the reconstructed q varies by dzq inside level l
     DO l=2,llm-1
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              IF(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) THEN
@@ -211 +224 @@
 
     ! 0 slope in top and bottom layers
-    DO j=jj_begin-1,jj_end+1
-       DO i=ii_begin-1,ii_end+1
+    DO j=jj_begin-halo,jj_end+halo
+       DO i=ii_begin-halo,ii_end+halo
           ij=(j-1)*iim+i
           dzq(ij,1)=0.
@@ -222 +235 @@
     ! then amount of q leaving level l/l+1 = wq = w * qq
     DO l = 1,llm-1
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              w = fac*wfluxt(ij,l+1)
@@ -238 +251 @@
     END DO
     ! wq = 0 at top and bottom
-    DO j=jj_begin-1,jj_end+1
-       DO i=ii_begin-1,ii_end+1
+    DO j=jj_begin-halo,jj_end+halo
+       DO i=ii_begin-halo,ii_end+halo
           ij=(j-1)*iim+i
           wq(ij,llm+1)=0.
@@ -248 +261 @@
     ! update q, mass is updated only after all q's have been updated
     DO l=1,llm
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
+       DO j=jj_begin-halo,jj_end+halo
+          DO i=ii_begin-halo,ii_end+halo
              ij=(j-1)*iim+i
              newmass = mass(ij,l) + fac*(wfluxt(ij,l)-wfluxt(ij,l+1))
@@ -258 +271 @@
     END DO
 
+    CALL trace_end("vlz")
+
   END SUBROUTINE vlz