Changeset 3800 for LMDZ6


Ignore:
Timestamp:
Jan 15, 2021, 6:10:56 PM (3 years ago)
Author:
Laurent Fairhead
Message:

Modifications nécessaires pour les isotopes
CRisi

Location:
LMDZ6/trunk/libf
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    • Property svn:keywords set to Id
    r3666 r3800  
    3232  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    3333  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
     34  REAL :: qperemin,masseqmin,ratiomin ! MVals et CRisi
     35  PARAMETER (qperemin=1e-16,masseqmin=1e-16,ratiomin=1e-16) ! MVals
    3436
    3537! conv_flg(it)=0 : convection desactivated for tracer number it

  • LMDZ6/trunk/libf/dyn3dmem/qminimum_loc.F

    • Property svn:keywords set to Id
    r2600 r3800  
     1!
     2!     $Id$
     3!
    14      SUBROUTINE qminimum_loc( q,nqtot,deltap )
    25      USE parallel_lmdz
    3       USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif
     6      USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif,             &
     7     &   ratiomin,qperemin ! CRisi 23nov2020
    48      IMPLICIT none
    59c
    … …  
    4953c
    5054
    51         !write(*,*) 'qminimum 52: entree'
     55        !write(lunout,*) 'qminimum 52: entree'
    5256        if (ok_iso_verif) then
    5357           call check_isotopes(q,ij_begin,ij_end,'qminimum 52')   
    … …  
    6064      q_follow(ijb:ije,:,1:2)=q(ijb:ije,:,1:2) 
    6165
    62       !write(*,*) 'qminimum 57'
     66      !write(lunout,*) 'qminimum 57'
    6367c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    6468      DO 1000 k = 1, llm
    … …  
    8589c le defaut en prennant de l'eau vapeur de la couche au-dessous.
    8690c
    87       !write(*,*) 'qminimum 81'
     91      !write(lunout,*) 'qminimum 81'
    8892      iq = iq_vap
    8993c
    … …  
    113117c doit imprimer un message d'avertissement (saturation possible).
    114118c
    115       !write(*,*) 'qminimum 106'
     119      !write(lunout,*) 'qminimum 106'
    116120      nb_pump=0
    117121c$OMP DO SCHEDULE(STATIC)
    … …  
    135139      ENDIF
    136140
    137       !write(*,*) 'qminimum 128'
     141      !write(lunout,*) 'qminimum 128'
    138142      if (ok_isotopes) then
     143              !write(lunout,*) 'qminimum 140'
    139144      ! CRisi: traiter de même les traceurs d'eau
    140145      ! Mais il faut les prendre à l'envers pour essayer de conserver la
    … …  
    144149      ! rien ici et on croise les doigts pour que ça ne soit pas trop
    145150      ! génant
     151      ! en fait, si, c'est genant quand les isotopes doivent eux même transporter des
     152      ! traceurs -> apporter aussi un peu d'isotopes... Combien?
     153      ! Essayer tnat/2 = -500 permil? C'est déjà mieux que -1000
     154      ! permil...
     155      ! pb: que faire pour les traceurs?
     156c$OMP DO SCHEDULE(STATIC)     
    146157      DO i = ijb, ije
    147158        if (zx_pump(i).gt.0.0) then
    … …  
    149160        endif !if (zx_pump(i).gt.0.0) then
    150161      enddo !DO i = ijb, ije 
     162c$OMP END DO
    151163
    152164      ! 2) transfert de vap vers les couches plus hautes
    153       !write(*,*) 'qminimum 139'
     165      !write(lunout,*) 'qminimum 158'
    154166      do k=2,llm
     167c$OMP DO SCHEDULE(STATIC)     
    155168        DO i = ijb, ije
    156169          if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
    157               ! on ajoute la vapeur en k             
    158               do ixt=1,ntraciso
     170              ! on ajoute la vapeur en k     
     171!              write(lunout,*) 'i,k,q_follow(i,k-1,iq_vap)=',
     172!     :                 i,k,q_follow(i,k-1,iq_vap)         
     173              if (q_follow(i,k-1,iq_vap).lt.qperemin) then
     174                write(lunout,*) 'tmp qmin: on stoppe'
     175                write(lunout,*) 'zx_pump(i)=',zx_pump(i)
     176                write(lunout,*) 'q_follow(i,:,iq_vap)=',
     177     :                   q_follow(i,:,iq_vap)
     178                write(lunout,*) 'k=',k
     179                call abort_gcm("qminimum","not enough vapor",1)
     180              endif 
     181            do ixt=1,ntraciso
     182!                write(lunout,*) 'qmin 168: ixt=',ixt
     183!                write(lunout,*) 'q(i,k,iqiso(ixt,iq_vap)=',
     184!     :             q(i,k,iqiso(ixt,iq_vap))
     185!                write(lunout,*) 'zx_defau_diag(i,k,iq_vap)=',
     186!     :                  zx_defau_diag(i,k,iq_vap)
     187!                write(lunout,*) 'q(i,k-1,iqiso(ixt,iq_vap)=',
     188!     :                   q(i,k-1,iqiso(ixt,iq_vap))     
     189
    159190               q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
    160191     :              +zx_defau_diag(i,k,iq_vap)
    … …  
    207238          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
    208239        enddo !DO i = 1, ip1jmp1       
    209        enddo !do k=2,llm
     240c$OMP END DO
     241        enddo !do k=2,llm
    210242
    211243        if (ok_iso_verif) then
    … …  
    217249        !write(*,*) 'qminimum 164'
    218250        do k=1,llm
     251c$OMP DO SCHEDULE(STATIC)
    219252        DO i = ijb, ije
    220253          if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
    … …  
    235268     :               -zx_defau_diag(i,k,iq_liq)
    236269          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
    237         enddo !DO i = 1, ip1jmp1
     270        enddo !DO i = ijb, ije
     271c$OMP END DO       
    238272       enddo !do k=2,llm 
    239273

  • LMDZ6/trunk/libf/dyn3dmem/vlsplt_loc.F

    • Property svn:keywords set to Id
    r3435 r3800  
    1414c   --------------------------------------------------------------------
    1515      USE parallel_lmdz
    16       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     16      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     17     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    1718      IMPLICIT NONE
    1819c
    … …  
    329330! Il faut faire ça avant d'avoir mis à jour q et masse
    330331
    331       !write(*,*) 'vlsplt 326: iq,ijb_x,nqfils(iq)=',iq,ijb_x,nqfils(iq)
    332 
    333       if (nqfils(iq).gt.0) then 
     332       if (nqfils(iq).gt.0) then
    334333       do ifils=1,nqdesc(iq)
     334       !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020
     335        ! attention: comme Ratio est utilisé comme q dans l'appel
     336        ! recursif, il doit contenir à lui seul tous les indices de tous
     337        ! les descendants!
    335338         iq2=iqfils(ifils,iq)
    336339c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    339342           ! On a besoin de q et masse seulement entre ijb et ije. On ne
    340343           ! les calcule donc que de ijb à ije
    341            masse(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    342            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     344           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     345           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     346           if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     347             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     348           else
     349             Ratio(ij,l,iq2)=ratiomin
     350           endif
    343351          enddo   
    344352         enddo
    … …  
    352360! end CRisi
    353361
    354       !write(*,*) 'vlsplt 360: iq,ijb_x=',iq,ijb_x
    355362
    356363c   calcul des tENDances
    … …  
    358365      DO l=1,llm
    359366         DO ij=ijb+1,ije
    360             new_m=masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l)
     367            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     368            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
    361369            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    362370     &        u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    371379      ENDDO
    372380c$OMP END DO NOWAIT
    373       !write(*,*) 'vlsplt 380: iq,ijb_x=',iq,ijb_x
    374381
    375382! retablir les fils en rapport de melange par rapport a l'air:
    … …  
    378385      if (nqfils(iq).gt.0) then 
    379386       do ifils=1,nqdesc(iq)
     387       !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020
    380388         iq2=iqfils(ifils,iq) 
    381389c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    … …  
    414422c   --------------------------------------------------------------------
    415423      USE parallel_lmdz
    416       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     424      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     425     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi   
    417426      USE comconst_mod, ONLY: pi
    418427      IMPLICIT NONE
    … …  
    468477      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
    469478      INTEGER ijb,ije
     479      INTEGER ijbm,ijem
    470480
    471481      ijb=ij_begin-2*iip1
    … …  
    726736      ijb=ij_begin-2*iip1
    727737      ije=ij_end+2*iip1
     738      ijbm=ij_begin-iip1
     739      ijem=ij_end+iip1
    728740      if (pole_nord) ijb=ij_begin
    729       if (pole_sud)  ije=ij_end
    730    
     741      if (pole_sud)  ije=ij_end 
     742      if (pole_nord) ijbm=ij_begin
     743      if (pole_sud)  ijem=ij_end
     744
    731745      if (nqfils(iq).gt.0) then 
    732746       do ifils=1,nqdesc(iq)
     747       !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020
    733748         iq2=iqfils(ifils,iq)
    734749c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    735750         DO l=1,llm
     751          ! modif des bornes: CRisi 16 nov 2020
     752          ! d'abord masse avec bornes corrigées
     753          DO ij=ijbm,ijem
     754           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     755           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     756          enddo !DO ij=ijbm,ijem
     757
     758          ! ensuite Ratio avec anciennes bornes
    736759         DO ij=ijb,ije
    737            masse(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    738            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
    739           enddo   
    740          enddo
     760           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     761           if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     762             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     763           else
     764             Ratio(ij,l,iq2)=ratiomin 
     765           endif     
     766          enddo !DO ij=ijbm,ijem 
     767         enddo !DO l=1,llm
    741768c$OMP END DO NOWAIT
    742769        enddo !do ifils=1,nqdesc(iq)
    … …  
    868895      USE parallel_lmdz
    869896      USE vlz_mod
    870       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi 
     897      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     898     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     899     
    871900      IMPLICIT NONE
    872901c
    … …  
    10841113                lorig(ij,l)=lorig(ij,l)-1
    10851114             ENDIF
     1115             ! CRisi 24nov2020: ajout d'un message d'erreur clair au lieu d'un plantage
     1116             ! pour seg fault
     1117             if (lorig(ij,l).eq.0) then
     1118                call abort_gcm("vlz in vlsplt_loc",
     1119     :           "unfixable violation of CFL",1)
     1120             endif
    10861121             morig(ij,l)=masse(ij,lorig(ij,l),iq)
    10871122             qorig(ij,l)=q(ij,lorig(ij,l),iq)
    … …  
    11271162      if (nqfils(iq).gt.0) then 
    11281163       do ifils=1,nqdesc(iq)
     1164       !do ifils=1,nqfils(iq) ! modif C Risi 22 nov 2020
    11291165         iq2=iqfils(ifils,iq)
    11301166c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    11311167         DO l=1,llm
    11321168          DO ij=ijb,ije
    1133            masse(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    1134            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     1169           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     1170           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     1171           if (q(ij,l,iq).gt.qperemin) then
     1172             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     1173           else
     1174             Ratio(ij,l,iq2)=ratiomin
     1175           endif
    11351176           !wq(ij,l,iq2)=wq(ij,l,iq) ! correction bug le 15mai2015
    11361177           w(ij,l,iq2)=wq(ij,l,iq)

  • LMDZ6/trunk/libf/dyn3dmem/vlspltqs_loc.F

    • Property svn:keywords set to Id
    r2603 r3800  
     1!
     2!     $Id$
     3!
    14      SUBROUTINE vlxqs_loc(q,pente_max,masse,u_m,qsat,ijb_x,ije_x,iq)
    25c
    … …  
    912c   --------------------------------------------------------------------
    1013      USE parallel_lmdz
    11       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi 
     14      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     15     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    1216      IMPLICIT NONE
    1317c
    … …  
    342346         DO l=1,llm
    343347          DO ij=ijb,ije
    344            masse(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    345            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
     348           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     349           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     350           if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     351             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     352           else
     353             Ratio(ij,l,iq2)=ratiomin
     354           endif
    346355          enddo   
    347356         enddo
    … …  
    362371      DO l=1,llm
    363372         DO ij=ijb+1,ije
    364             new_m=masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l)
     373            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     374            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
    365375            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    366376     &      u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    416426c   --------------------------------------------------------------------
    417427      USE parallel_lmdz
    418       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi 
     428      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     429     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    419430      USE comconst_mod, ONLY: pi
    420431      IMPLICIT NONE
    … …  
    423434      include "paramet.h"
    424435      include "comgeom.h"
     436      include "iniprint.h" 
    425437c
    426438c
    … …  
    464476      DATA first/.true./
    465477      INTEGER ijb,ije
     478      INTEGER ijbm,ijem
    466479
    467480      ijb=ij_begin-2*iip1
    … …  
    724737      ijb=ij_begin-2*iip1
    725738      ije=ij_end+2*iip1
     739      ijbm=ij_begin-iip1
     740      ijem=ij_end+iip1
    726741      if (pole_nord) ijb=ij_begin
    727742      if (pole_sud)  ije=ij_end 
    728 
     743      if (pole_nord) ijbm=ij_begin
     744      if (pole_sud)  ijem=ij_end
     745
     746      !write(lunout,*) 'vlspltqs 737: iq,ijb,ije=',iq,ijb,ije
     747      !write(lunout,*) 'ij_begin,ij_end=',ij_begin,ij_end
     748      !write(lunout,*) 'pole_nord,pole_sud=',pole_nord,pole_sud
    729749      if (nqfils(iq).gt.0) then 
    730750       do ifils=1,nqdesc(iq)
    … …  
    732752c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    733753         DO l=1,llm
     754          ! modif des bornes: CRisi 16 nov 2020
     755          ! d'abord masse avec bornes corrigées
     756          DO ij=ijbm,ijem
     757           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     758           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     759          enddo !DO ij=ijbm,ijem
     760
     761          ! ensuite Ratio avec anciennes bornes
    734762          DO ij=ijb,ije
    735            masse(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    736            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)   
    737           enddo   
    738          enddo
     763           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     764           !write(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq)
     765           if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     766             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     767           else
     768             Ratio(ij,l,iq2)=ratiomin   
     769           endif
     770          enddo !DO ij=ijbm,ijem
     771         enddo !DO l=1,llm
    739772c$OMP END DO NOWAIT
    740773        enddo !do ifils=1,nqdesc(iq)
    741774        do ifils=1,nqfils(iq)
    742775         iq2=iqfils(ifils,iq)
     776         !write(lunout,*) 'vly: appel recursiv vly iq2=',iq2
    743777         call vly_loc(Ratio,pente_max,masse,qbyv,iq2)
    744778        enddo !do ifils=1,nqfils(iq)
Note: See TracChangeset for help on using the changeset viewer.