Changeset 3800 for LMDZ6/trunk/libf/dyn3dmem/qminimum_loc.F

Timestamp:

Jan 15, 2021, 6:10:56 PM (4 years ago)

Author:

Laurent Fairhead

Message:

Modifications nécessaires pour les isotopes
CRisi

File:

• LMDZ6/trunk/libf/dyn3dmem/qminimum_loc.F (modified) (11 diffs, 1 prop)

LMDZ6/trunk/libf/dyn3dmem/qminimum_loc.F

@@ +1 @@
+!
+!     $Id$
+!
       SUBROUTINE qminimum_loc( q,nqtot,deltap )
       USE parallel_lmdz
-      USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif
+      USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif,             &
+     &   ratiomin,qperemin ! CRisi 23nov2020
       IMPLICIT none
 c
@@ -49 +53 @@
 c
 
-        !write(*,*) 'qminimum 52: entree'
+        !write(lunout,*) 'qminimum 52: entree'
         if (ok_iso_verif) then
            call check_isotopes(q,ij_begin,ij_end,'qminimum 52')   
@@ -60 +64 @@
       q_follow(ijb:ije,:,1:2)=q(ijb:ije,:,1:2)  
 
-      !write(*,*) 'qminimum 57'
+      !write(lunout,*) 'qminimum 57'
 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
       DO 1000 k = 1, llm
@@ -85 +89 @@
 c le defaut en prennant de l'eau vapeur de la couche au-dessous.
 c
-      !write(*,*) 'qminimum 81'
+      !write(lunout,*) 'qminimum 81'
       iq = iq_vap
 c
@@ -113 +117 @@
 c doit imprimer un message d'avertissement (saturation possible).
 c
-      !write(*,*) 'qminimum 106'
+      !write(lunout,*) 'qminimum 106'
       nb_pump=0
 c$OMP DO SCHEDULE(STATIC)
@@ -135 +139 @@
       ENDIF
 
-      !write(*,*) 'qminimum 128'
+      !write(lunout,*) 'qminimum 128'
       if (ok_isotopes) then
+              !write(lunout,*) 'qminimum 140'
       ! CRisi: traiter de même les traceurs d'eau
       ! Mais il faut les prendre à l'envers pour essayer de conserver la
@@ -144 +149 @@
       ! rien ici et on croise les doigts pour que ça ne soit pas trop
       ! génant
+      ! en fait, si, c'est genant quand les isotopes doivent eux même transporter des
+      ! traceurs -> apporter aussi un peu d'isotopes... Combien?
+      ! Essayer tnat/2 = -500 permil? C'est déjà mieux que -1000
+      ! permil...
+      ! pb: que faire pour les traceurs?
+c$OMP DO SCHEDULE(STATIC)      
       DO i = ijb, ije
         if (zx_pump(i).gt.0.0) then
@@ -149 +160 @@
         endif !if (zx_pump(i).gt.0.0) then
       enddo !DO i = ijb, ije  
+c$OMP END DO
 
       ! 2) transfert de vap vers les couches plus hautes
-      !write(*,*) 'qminimum 139'
+      !write(lunout,*) 'qminimum 158'
       do k=2,llm
+c$OMP DO SCHEDULE(STATIC)      
         DO i = ijb, ije
           if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
-              ! on ajoute la vapeur en k              
-              do ixt=1,ntraciso
+              ! on ajoute la vapeur en k     
+!              write(lunout,*) 'i,k,q_follow(i,k-1,iq_vap)=',
+!     :                 i,k,q_follow(i,k-1,iq_vap)          
+              if (q_follow(i,k-1,iq_vap).lt.qperemin) then
+                write(lunout,*) 'tmp qmin: on stoppe'
+                write(lunout,*) 'zx_pump(i)=',zx_pump(i)
+                write(lunout,*) 'q_follow(i,:,iq_vap)=',
+     :                   q_follow(i,:,iq_vap)
+                write(lunout,*) 'k=',k
+                call abort_gcm("qminimum","not enough vapor",1)
+              endif  
+            do ixt=1,ntraciso
+!                write(lunout,*) 'qmin 168: ixt=',ixt
+!                write(lunout,*) 'q(i,k,iqiso(ixt,iq_vap)=',
+!     :             q(i,k,iqiso(ixt,iq_vap))
+!                write(lunout,*) 'zx_defau_diag(i,k,iq_vap)=',
+!     :                  zx_defau_diag(i,k,iq_vap)
+!                write(lunout,*) 'q(i,k-1,iqiso(ixt,iq_vap)=',
+!     :                   q(i,k-1,iqiso(ixt,iq_vap))     
+
                q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
      :              +zx_defau_diag(i,k,iq_vap)
@@ -207 +238 @@
           endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
         enddo !DO i = 1, ip1jmp1        
-       enddo !do k=2,llm
+c$OMP END DO
+        enddo !do k=2,llm
 
         if (ok_iso_verif) then
@@ -217 +249 @@
         !write(*,*) 'qminimum 164'
         do k=1,llm
+c$OMP DO SCHEDULE(STATIC)
         DO i = ijb, ije
           if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
@@ -235 +268 @@
      :               -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 i = ijb, ije
+c$OMP END DO        
        enddo !do k=2,llm