Changeset 3800 for LMDZ6/trunk/libf/dyn3dmem/vlspltqs_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/vlspltqs_loc.F (modified) (9 diffs, 1 prop)

LMDZ6/trunk/libf/dyn3dmem/vlspltqs_loc.F

@@ +1 @@
+!
+!     $Id$
+!
       SUBROUTINE vlxqs_loc(q,pente_max,masse,u_m,qsat,ijb_x,ije_x,iq)
 c
@@ -9 +12 @@
 c   --------------------------------------------------------------------
       USE parallel_lmdz
-      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi  
+      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
+     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
       IMPLICIT NONE
 c
@@ -342 +346 @@
          DO l=1,llm
           DO ij=ijb,ije
-           masse(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
-           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)      
+           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
+           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
+           if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
+             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
+           else
+             Ratio(ij,l,iq2)=ratiomin
+           endif 
           enddo   
          enddo
@@ -362 +371 @@
       DO l=1,llm
          DO ij=ijb+1,ije
-            new_m=masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l)
+            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
+            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
             q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
      &      u_mq(ij-1,l)-u_mq(ij,l))
@@ -416 +426 @@
 c   --------------------------------------------------------------------
       USE parallel_lmdz
-      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi  
+      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
+     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
       USE comconst_mod, ONLY: pi
       IMPLICIT NONE
@@ -423 +434 @@
       include "paramet.h"
       include "comgeom.h"
+      include "iniprint.h"  
 c
 c
@@ -464 +476 @@
       DATA first/.true./
       INTEGER ijb,ije
+      INTEGER ijbm,ijem
 
       ijb=ij_begin-2*iip1
@@ -724 +737 @@
       ijb=ij_begin-2*iip1
       ije=ij_end+2*iip1
+      ijbm=ij_begin-iip1
+      ijem=ij_end+iip1
       if (pole_nord) ijb=ij_begin
       if (pole_sud)  ije=ij_end  
-
+      if (pole_nord) ijbm=ij_begin
+      if (pole_sud)  ijem=ij_end
+
+      !write(lunout,*) 'vlspltqs 737: iq,ijb,ije=',iq,ijb,ije
+      !write(lunout,*) 'ij_begin,ij_end=',ij_begin,ij_end
+      !write(lunout,*) 'pole_nord,pole_sud=',pole_nord,pole_sud
       if (nqfils(iq).gt.0) then  
        do ifils=1,nqdesc(iq)
@@ -732 +752 @@
 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
          DO l=1,llm
+          ! modif des bornes: CRisi 16 nov 2020
+          ! d'abord masse avec bornes corrigées
+          DO ij=ijbm,ijem 
+           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
+           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
+          enddo !DO ij=ijbm,ijem 
+
+          ! ensuite Ratio avec anciennes bornes
           DO ij=ijb,ije
-           masse(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
-           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)   
-          enddo   
-         enddo
+           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
+           !write(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq)
+           if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
+             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
+           else
+             Ratio(ij,l,iq2)=ratiomin   
+           endif
+          enddo !DO ij=ijbm,ijem
+         enddo !DO l=1,llm
 c$OMP END DO NOWAIT
         enddo !do ifils=1,nqdesc(iq)
         do ifils=1,nqfils(iq)
          iq2=iqfils(ifils,iq)
+         !write(lunout,*) 'vly: appel recursiv vly iq2=',iq2
          call vly_loc(Ratio,pente_max,masse,qbyv,iq2)
         enddo !do ifils=1,nqfils(iq)