Changeset 1508 for trunk/LMDZ.COMMON/libf/dyn3d/qminimum.F

Timestamp:

Jan 15, 2016, 8:27:16 AM (9 years ago)

Author:

emillour

Message:

Common dynamics:
Updates in the dynamics (seq and ) to keep up with updates
in LMDZ5 (up to LMDZ5 trunk, rev 2325):
IMPORTANT: Modifications for isotopes are only done in dyn3d, not in dyn3dpar

as in LMDZ5 these modifications were done in dyn3dmem.
Related LMDZ5 revisions are r2270 and r2281

• in dynlonlat_phylonlat:
• add module "grid_atob_m.F90" (a regridding utility so far only used by phylmd/ce0l.F90, used to be dyn3d_common/grid_atob.F)

• in misc:
• follow up updates on wxios.F (add missing_val module variable)

• in dyn3d_common:
• pression.F => pression.F90
• misc_mod.F90: moved from misc to dyn3d_common
• added new iso_verif_dyn.F
• covcont.F => covcont.F90
• infotrac.F90 : add handling of isotopes (reading of corresponding traceur.def for planets not implemented)
• dynetat0.F => dynetat0.F90 with some code factorization
• dynredem.F => dynredem.F90 with some code factorization
• added dynredem_mod.F90: routines used by dynredem
• iniacademic.F90 : added isotopes-related initialization for Earth case

• in dyn3d:
• added check_isotopes.F
• modified (isotopes) advtrac.F90, caladvtrac.F
• guide_mod.F90: ported updates
• leapfrog.F : (isotopes) updates (NB: call integrd with nqtot tracers)
• qminimium.F : adaptations for isotopes (copied over, except that #include comvert.h is not needed).
• vlsplt.F: adaptations for isotopes (copied over, except than #include logic.h, comvert.h not needed, and replace "include comconst.h" with use comconst_mod, ONLY: pi)
• vlspltqs.F : same as vlsplt.F, but also keeping added modification for CP(T)

• in dyn3dpar:
• leapfrog_p.F: remove unecessary #ifdef CPP_EARTH cpp flag. and call integrd_p with nqtot tracers (only important for Earth)
• dynredem_p.F => dynredem_p.F90 and some code factorization
• and no isotopes-relates changes in dyn3dpar (since these changes have been made in LMDZ5 dyn3dmem).

EM

File:

• trunk/LMDZ.COMMON/libf/dyn3d/qminimum.F (modified) (7 diffs)

trunk/LMDZ.COMMON/libf/dyn3d/qminimum.F

@@ -2 +2 @@
 ! $Header$
 !
-      SUBROUTINE qminimum( q,nq,deltap )
+      SUBROUTINE qminimum( q,nqtot,deltap )
 
+      USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif
       IMPLICIT none
 c
@@ -12 +13 @@
 #include "paramet.h"
 c
-      INTEGER nq
-      REAL q(ip1jmp1,llm,nq), deltap(ip1jmp1,llm)
+      INTEGER nqtot
+      REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm)
 c
       INTEGER iq_vap, iq_liq
@@ -29 +30 @@
       INTEGER i, k, iq
       REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
+
+      real zx_defau_diag(ip1jmp1,llm,2) 
+      real q_follow(ip1jmp1,llm,2)
 c
       REAL SSUM
@@ -35 +39 @@
       SAVE imprim
       DATA imprim /0/
+      !INTEGER ijb,ije
+      !INTEGER Index_pump(ij_end-ij_begin+1)
+      !INTEGER nb_pump
+      INTEGER ixt
 c
 c Quand l'eau liquide est trop petite (ou negative), on prend
@@ -40 +48 @@
 c (sans changer la temperature !)
 c
+
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
+        endif !if (ok_iso_verif) then     
+
+      zx_defau_diag(:,:,:)=0.0
+      q_follow(:,:,1:2)=q(:,:,1:2)  
       DO 1000 k = 1, llm
         DO 1040 i = 1, ip1jmp1
           if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
+
+              if (ok_isotopes) then
+                 zx_defau_diag(i,k,iq_liq)=AMAX1
+     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
+              endif !if (ok_isotopes) then
+
              q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
              q(i,k,iq_liq) = seuil_liq
@@ -58 +79 @@
         DO i = 1, ip1jmp1
           if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
+
+            if (ok_isotopes) then
+              zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
+            endif !if (ok_isotopes) then
+
             q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
      &                     deltap(i,k) / deltap(i,k-1)
@@ -82 +108 @@
          ENDDO
       ENDIF
+
+      !write(*,*) 'qminimum 128'
+      if (ok_isotopes) then
+      ! CRisi: traiter de même les traceurs d'eau
+      ! Mais il faut les prendre à l'envers pour essayer de conserver la
+      ! masse.
+      ! 1) pompage dans le sol  
+      ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
+      ! rien ici et on croise les doigts pour que ça ne soit pas trop
+      ! génant
+      DO i = 1,ip1jmp1
+        if (zx_pump(i).gt.0.0) then
+          q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)
+        endif !if (zx_pump(i).gt.0.0) then
+      enddo !DO i = 1,ip1jmp1
+
+      ! 2) transfert de vap vers les couches plus hautes
+      !write(*,*) 'qminimum 139'
+      do k=2,llm
+        DO i = 1,ip1jmp1
+          if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
+              ! on ajoute la vapeur en k              
+              do ixt=1,ntraciso
+               q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
+     :              +zx_defau_diag(i,k,iq_vap)
+     :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
+                
+              ! et on la retranche en k-1
+               q(i,k-1,iqiso(ixt,iq_vap))=q(i,k-1,iqiso(ixt,iq_vap))
+     :              -zx_defau_diag(i,k,iq_vap)
+     :              *deltap(i,k)/deltap(i,k-1)
+     :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
+
+              enddo !do ixt=1,niso
+              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
+     :               +zx_defau_diag(i,k,iq_vap)
+              q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
+     :               -zx_defau_diag(i,k,iq_vap)
+     :              *deltap(i,k)/deltap(i,k-1)
+          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+        enddo !DO i = 1, ip1jmp1        
+       enddo !do k=2,llm
+
+        if (ok_iso_verif) then     
+           call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
+        endif !if (ok_iso_verif) then
+        
+      
+        ! 3) transfert d'eau de la vapeur au liquide
+        !write(*,*) 'qminimum 164'
+        do k=1,llm
+        DO i = 1,ip1jmp1
+          if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
+
+              ! on ajoute eau liquide en k en k              
+              do ixt=1,ntraciso
+               q(i,k,iqiso(ixt,iq_liq))=q(i,k,iqiso(ixt,iq_liq))
+     :              +zx_defau_diag(i,k,iq_liq)
+     :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)
+              ! et on la retranche à la vapeur en k
+               q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
+     :              -zx_defau_diag(i,k,iq_liq)
+     :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)   
+              enddo !do ixt=1,niso
+              q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
+     :               +zx_defau_diag(i,k,iq_liq)
+              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
+     :               -zx_defau_diag(i,k,iq_liq)
+          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+        enddo !DO i = 1, ip1jmp1
+       enddo !do k=2,llm  
+
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
+        endif !if (ok_iso_verif) then
+
+      endif !if (ok_isotopes) then
+      !write(*,*) 'qminimum 188'
+      
 c
       RETURN