Changeset 599 for codes/icosagcm/trunk/src/transport/advect_tracer.f90

Timestamp:

10/19/17 17:04:26 (7 years ago)

Author:

dubos

Message:

trunk : backported commits r582-r598 (transport diagnostics)

File:

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

codes/icosagcm/trunk/src/transport/advect_tracer.f90

@@ -1 +1 @@
 MODULE advect_tracer_mod
   USE icosa
+  USE advect_mod
   IMPLICIT NONE
   PRIVATE
@@ -25 +26 @@
 
   SUBROUTINE init_advect_tracer
-    USE advect_mod
     USE omp_para
     REAL(rstd),POINTER :: tangent(:,:)
@@ -54 +54 @@
   END SUBROUTINE init_advect_tracer
 
-  SUBROUTINE advect_tracer(f_hfluxt, f_wfluxt,f_u, f_q,f_rhodz)
-    USE advect_mod
-    USE mpipara
+  SUBROUTINE advect_tracer(f_hfluxt, f_wfluxt,f_u, f_q,f_rhodz,&
+       frac, f_masst,f_qmasst,f_massfluxt,f_qfluxt)
+    USE omp_para
     USE trace
     USE write_field_mod
     USE tracer_mod
-    IMPLICIT NONE
-    
     TYPE(t_field),POINTER :: f_hfluxt(:)   ! time-integrated horizontal mass flux
     TYPE(t_field),POINTER :: f_wfluxt(:)   ! time-integrated vertical mass flux
@@ -67 +65 @@
     TYPE(t_field),POINTER :: f_q(:)        ! tracer
     TYPE(t_field),POINTER :: f_rhodz(:)    ! mass field at beginning of macro time step
+    REAL(rstd), INTENT(in):: frac          ! ratio itau_adv/itau_out or 0. if not diagflux_on
+    TYPE(t_field),POINTER :: f_masst(:)    ! time-integrated mass
+    TYPE(t_field),POINTER :: f_qmasst(:)   ! time-integrated tracer mass
+    TYPE(t_field),POINTER :: f_massfluxt(:)! time-integrated horizontal mass flux
+    TYPE(t_field),POINTER :: f_qfluxt(:)   ! time-integrated horizontal tracer flux
 
     REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), sqrt_leng(:), gradq3d(:,:,:), cc(:,:,:)
-    REAL(rstd),POINTER :: hfluxt(:,:), wfluxt(:,:)
+    REAL(rstd),POINTER :: hfluxt(:,:), wfluxt(:,:), masst(:,:), qmasst(:,:,:), massfluxt(:,:), qfluxt(:,:,:)
     REAL(rstd),POINTER :: rhodz(:,:), u(:,:) 
 ! temporary shared variable for vlz
@@ -77 +80 @@
     REAL(rstd),POINTER ::  wq(:,:)           ! time-integrated flux of q
     
-     INTEGER :: ind,k, nq_last
+    INTEGER :: ind,k, nq_last
     LOGICAL,SAVE :: first=.TRUE.
 !$OMP THREADPRIVATE(first)
@@ -141 +144 @@
     CALL send_message(f_cc,req_cc)
 
-
     ! horizontal transport - split in two to place transfer of gradq3d
     DO k = 1, nqtot
@@ -154 +156 @@
           sqrt_leng=f_sqrt_leng(ind)
           CALL compute_gradq3d(q(:,:,k),sqrt_leng,gradq3d,xyz_i,xyz_v)
-
         END DO
 
@@ -160 +161 @@
         CALL wait_message(req_cc)
         CALL wait_message(req_gradq3d)
-
 
         DO ind=1,ndomain
@@ -170 +170 @@
           rhodz   = f_rhodz(ind)
           hfluxt  = f_hfluxt(ind) 
+          qfluxt  = f_qfluxt(ind) 
           gradq3d = f_gradq3d(ind)
-          CALL compute_advect_horiz(k==nq_last,hfluxt,cc,gradq3d, rhodz,q(:,:,k))
+
+          IF(frac>0.) THEN ! accumulate mass, mass flux and tracer mass
+             qmasst  = f_qmasst(ind) 
+             qmasst(:,ll_begin:ll_end,k) = qmasst(:,ll_begin:ll_end,k) + &
+                  frac*rhodz(:,ll_begin:ll_end)*q(:,ll_begin:ll_end,k)
+             IF(k==nq_last) THEN
+                masst  = f_masst(ind)
+                massfluxt  = f_massfluxt(ind)
+                masst(:,ll_begin:ll_end) = masst(:,ll_begin:ll_end)+frac*rhodz(:,ll_begin:ll_end)
+                massfluxt(:,ll_begin:ll_end) = massfluxt(:,ll_begin:ll_end)+hfluxt(:,ll_begin:ll_end)
+             END IF
+          END IF
+          CALL compute_advect_horiz(k==nq_last,frac>0., hfluxt,cc,gradq3d, rhodz, q(:,:,k), qfluxt(:,:,k))
         END DO
+
       ENDIF
     END DO 
@@ -214 +228 @@
     USE trace
     USE omp_para
-    IMPLICIT NONE
     LOGICAL, INTENT(IN)       :: update_mass
     REAL(rstd), INTENT(IN)    :: fac, wfluxt(iim*jjm,llm+1) ! vertical mass flux