Ignore:
Timestamp:
Dec 23, 2021, 6:54:17 PM (3 years ago)
Author:
dcugnet
Message:

Second commit for new tracers.

  • include most of the keys in the tracers descriptor vector "tracers(:)".
  • fix in phylmdiso/cv3_routines: fq_* variables were used where their fxt_* counterparts were expected.
  • multiple IF(nqdesc(iq)>0) and IF(nqfils(iq)>0) tests suppressed, because they are not needed: "do ... enddo" loops with 0 upper bound are not executed.
  • remove French accents from comments (encoding problem) in phylmdiso/cv3_routines and phylmdiso/cv30_routines.
  • modifications in "isotopes_verif_mod", where the call to function "iso_verif_tag17_q_deltad_chn" in "iso_verif_tag17_q_deltad_chn" was not detected at linking stage, although defined in the same module (?).
Location:
LMDZ6/trunk/libf/phylmdiso
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmdiso/cv30_routines.F90

    r4004 r4050  
    449449
    450450#ifdef ISOVERIF
    451         write(*,*) 'cv30_routine undilute 1 413: entrée'
     451        write(*,*) 'cv30_routine undilute 1 413: entree'
    452452#endif
    453453
    … …  
    602602          zfice(i) = MIN(MAX(zfice(i),0.0),1.0)         
    603603       enddo
    604        ! calcul de la composition du condensat glacé et liquide
     604       ! calcul de la composition du condensat glace et liquide
    605605
    606606       do i=1,len
    … …  
    647647
    648648#ifdef ISOVERIF
    649             write(*,*) 'cv30_routine undilute 1 598: après condiso'
     649            write(*,*) 'cv30_routine undilute 1 598: apres condiso'
    650650         
    651651          if (iso_eau.gt.0) then
    … …  
    10121012            else
    10131013              q(i,k)=0.0
    1014               clw(i,k)=0.0 ! mise en commentaire le 5 avril pour vérif
     1014              clw(i,k)=0.0 ! mise en commentaire le 5 avril pour verif
    10151015!            convergence
    10161016            endif  !f (negation(essai_convergence)) then
    … …  
    19081908      real xtrti(ntraciso,nloc)
    19091909      real xtres(ntraciso)
    1910       ! on ajoute la dimension nloc à xtrti pour vérifs dans les tags: 5 fev
     1910      ! on ajoute la dimension nloc a xtrti pour verifs dans les tags: 5 fev
    19111911      ! 2010
    19121912      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
    … …  
    19231923#ifdef ISO
    19241924#ifdef ISOVERIF
    1925       write(*,*) 'cv30_routines 1820: entrée dans cv3_mixing'
     1925      write(*,*) 'cv30_routines 1820: entree dans cv3_mixing'
    19261926      if (iso_eau.gt.0) then
    19271927      call iso_verif_egalite_vect2D( &
    … …  
    19651965             xtelij(ixt,i,k,j)=0.0
    19661966            enddo !do ixt =1,niso
    1967             ! on initialise mieux que ça qent et elij, même si au final les
    1968             ! valeurs en nd=nl+1 ne sont pas utilisées
     1967            ! on initialise mieux que ca qent et elij, meme si au final les
     1968            ! valeurs en nd=nl+1 ne sont pas utilisees
    19691969            qent(i,k,j)=rr(i,j)
    19701970            elij(i,k,j)=0.0   
    … …  
    21212121!     :           'tcond(il),rs(il,j)=',
    21222122!     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
    2123         ! colorier la vapeur résiduelle selon température de
    2124         ! condensation, et le condensat en un tag spécifique
     2123        ! colorier la vapeur residuelle selon temperature de
     2124        ! condensation, et le condensat en un tag spEcifique
    21252125          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) then 
    21262126            if (option_traceurs.eq.17) then       
    … …  
    22412241#ifdef ISOTRAC         
    22422242        if (option_tmin.ge.1) then
    2243         ! colorier la vapeur résiduelle selon température de
    2244         ! condensation, et le condensat en un tag spécifique
     2243        ! colorier la vapeur residuelle selon temperature de
     2244        ! condensation, et le condensat en un tag specifique
    22452245!        write(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
    22462246!     :            il,i,j,xtent(:,il,i,j)
    … …  
    24752475#ifdef ISOTRAC         
    24762476        if (option_tmin.ge.1) then
    2477         ! colorier la vapeur résiduelle selon température de
    2478         ! condensation, et le condensat en un tag spécifique
     2477        ! colorier la vapeur residuelle selon temperature de
     2478        ! condensation, et le condensat en un tag specifique
    24792479!        write(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
    24802480!     :            il,i,j,xtent(:,il,i,j)
    … …  
    25792579#ifdef ISO
    25802580#ifdef ISOTRAC
    2581         ! seulement à la fin on taggue le condensat
     2581        ! seulement a la fin on taggue le condensat
    25822582        if (option_cond.ge.1) then
    25832583         do im = 1, nd
    25842584         do jm = 1, nd
    25852585         do il = 1, ncum   
    2586            ! colorier le condensat en un tag spécifique
     2586           ! colorier le condensat en un tag specifique
    25872587           do ixt=niso+1,ntraciso
    25882588             if (index_zone(ixt).eq.izone_cond) then
    … …  
    26032603         do im = 1, nd
    26042604         do il = 1, ncum   
    2605            ! colorier le condensat en un tag spécifique
     2605           ! colorier le condensat en un tag specifique
    26062606           do ixt=niso+1,ntraciso
    26072607             if (index_zone(ixt).eq.izone_cond) then
    … …  
    27392739  ! ------------------------------------------------------
    27402740!#ifdef ISOVERIF
    2741 !        write(*,*) 'cv30_routines 2382: entrée dans cv3_unsat'
     2741!        write(*,*) 'cv30_routines 2382: entree dans cv3_unsat'
    27422742!#endif
    27432743
    … …  
    27472747  mp(:, :) = 0.
    27482748#ifdef ISO
    2749   ! initialisation plus complète de water et rp
     2749  ! initialisation plus complete de water et rp
    27502750  water(:,:)=0.0
    27512751  xtwater(:,:,:)=0.0
    … …  
    29362936        call iso_verif_traceur(xtwdtrain(1,il),'cv30_routine 2540')
    29372937        if (option_cond.ge.1) then
    2938            ! on vérifie que tout le détrainement est taggé condensat
     2938           ! on verifie que tout le detrainement est tagge condensat
    29392939           if (iso_verif_positif_nostop( &
    29402940     &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
    … …  
    30323032
    30333033#ifdef ISO
    3034       ! ajout cam: éviter les evaporations ou eaux négatives
    3035 !      water(il,i)=max(0.0,water(il,i)) ! ceci est toujours vérifié
     3034      ! ajout cam: eviter les evaporations ou eaux negatives
     3035!      water(il,i)=max(0.0,water(il,i)) ! ceci est toujours verifie
    30363036#ifdef ISOVERIF
    30373037          call iso_verif_positif(water(il,i),'cv30_unsat 2376')
    … …  
    31893189#ifdef ISO
    31903190#ifdef ISOVERIF
    3191 ! verif des inputs à appel stewart
     3191! verif des inputs a appel stewart
    31923192!        write(*,*) 'cv30_routines 2842 tmp: appel de appel_stewart'
    31933193      do il=1,ncum
    … …  
    32083208       enddo
    32093209#endif
    3210         ! appel de appel_stewart_vectorisé
     3210        ! appel de appel_stewart_vectorise
    32113211        call appel_stewart_vectall(lwork,ncum, &
    32123212     &                   ph,t,evap,xtwdtrain, &
    … …  
    32683268#endif
    32693269       
    3270 ! équivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
     3270! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
    32713271       do il=1,ncum
    32723272        if (i.lt.inb(il) .and. lwork(il)) then
    … …  
    34633463      real xtbx(ntraciso), xtawat(ntraciso)
    34643464      ! cam debug
    3465       ! pour l'homogénéisation sous le nuage:
     3465      ! pour l'homogeneisation sous le nuage:
    34663466      real frsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
    3467       ! correction dans calcul tendance liée à Am:
     3467      ! correction dans calcul tendance liee a Am:
    34683468      real dq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp
    34693469      logical correction_excess_aberrant
    34703470      parameter (correction_excess_aberrant=.false.)
    3471         ! correction qui permettait d'éviter deltas et dexcess aberrants. Mais
     3471        ! correction qui permettait d'eviter deltas et dexcess aberrants. Mais
    34723472        ! pb: ne conserve pas la masse d'isotopes!
    34733473#ifdef DIAGISO
    3474         ! diagnostiques juste: tendance des différents processus
     3474        ! diagnostiques juste: tendance des differents processus
    34753475      real fxt_detrainement(ntraciso,nloc,nd)
    34763476      real fxt_fluxmasse(ntraciso,nloc,nd)
    … …  
    35173517#ifdef ISO
    35183518       ! cam debug
    3519 !       write(*,*) 'cv30_routines 3082: entrée dans cv3_yield'
     3519!       write(*,*) 'cv30_routines 3082: entree dans cv3_yield'
    35203520       ! en cam debug
    35213521       do ixt = 1, ntraciso
    … …  
    37493749        do ixt = 1, ntraciso
    37503750!        fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
    3751 !     &      +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) ! déplacé
    3752 !     plus haut car il existe différents cas
     3751!     &      +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) ! deplace
     3752!     plus haut car il existe differents cas
    37533753        fxt_ddft(ixt,il,1)=fxt_ddft(ixt,il,1) &
    37543754     &      +0.01*grav*mp(il,2)*(xtp(ixt,il,2)-xt(ixt,il,1))*work(il)
    … …  
    37593759
    37603760
    3761         ! pour l'ajout de la tendance liée au flux de masse Am, il faut être
     3761        ! pour l'ajout de la tendance liee au flux de masse Am, il faut etre
    37623762        ! prudent.
    37633763        ! On a dq1=k*(q2-q1) avec k=dt*0.01*grav*am(il)*work(il)
    3764         ! Pour les isotopes, la formule utilisée depuis 2006 et qui avait toujours marché est:
     3764        ! Pour les isotopes, la formule utilisee depuis 2006 et qui avait toujours marche est:
    37653765        ! dx1=k*(x2-x1)
    3766         ! Mais on plante dans un cas pathologique en décembre 2017 lors du test
    3767         ! d'un cas d'Anne Cozic: les isotopes deviennent négatifs.
     3766        ! Mais on plante dans un cas pathologique en decembre 2017 lors du test
     3767        ! d'un cas d'Anne Cozic: les isotopes deviennent negatifs.
    37683768        ! C'est un cas pas physique: on perd 99% de la masse de vapeur d'eau!
    37693769        ! q2=1.01e-3 et q1=1.25e-3 kg/kg
    3770         ! et dq=-1.24e-3: comment est-ce possible qu'un flux venant d'un air à
    3771         ! q2= 1.01e-3 assèche q1 jusqu'à 0.01e-3kg/kg!
    3772         ! Pour les isotopes, ça donne des x1+dx négatifs.
    3773         ! Ce n'est pas physique mais il faut quand même s'adapter.
    3774         ! Pour cela, on considère que d'abord on fait rentrer le flux de masse
     3770        ! et dq=-1.24e-3: comment est-ce possible qu'un flux venant d'un air a
     3771        ! q2= 1.01e-3 asseche q1 jusqu'a 0.01e-3kg/kg!
     3772        ! Pour les isotopes, ca donne des x1+dx negatifs.
     3773        ! Ce n'est pas physique mais il faut quand meme s'adapter.
     3774        ! Pour cela, on considere que d'abord on fait rentrer le flux de masse
    37753775        ! descendant, et ensuite seulement on fait sortir le flux de masse
    37763776        ! sortant.
    … …  
    37783778        ! isotopique de la vapeur d'eau q1.
    37793779        ! A la fin, on a R=(x1+dx)/(q1+dq)=(x1+k*x2)/(q1+k*q2)
    3780         ! On vérifie que quand k est petit, on tend vers la formulation
     3780        ! On verifie que quand k est petit, on tend vers la formulation
    37813781        ! habituelle.
    3782         ! Comme on est habitués à la formulation habituelle, qu'elle a fait ses
    3783         ! preuves, on la garde sauf dans le cas où dq/q<-0.9 où on utilise la
     3782        ! Comme on est habitues a la formulation habituelle, qu'elle a fait ses
     3783        ! preuves, on la garde sauf dans le cas ou dq/q<-0.9 ou on utilise la
    37843784        ! nouvelle formulation.
    37853785        ! rappel: dq_tmp=0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)*delt
    3786         ! Même avec cette nouvelle foirmulation, on a encore des isotopes
    3787         ! négatifs, cette fois à cause des ddfts
    3788         ! On considère donc les tendances et série et non en parallèle quand on
     3786        ! Meme avec cette nouvelle foirmulation, on a encore des isotopes
     3787        ! negatifs, cette fois a cause des ddfts
     3788        ! On considere donc les tendances et serie et non en parallele quand on
    37893789        ! calcule R_tmp.
    37903790        dq_tmp=0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)*delt ! utile ci-dessous
    37913791        if ((dq_tmp/rr(il,1).lt.-0.9).and.correction_excess_aberrant) then
    3792                 ! nouvelle formulation où on fait d'abord entrer k*q2 et ensuite
     3792                ! nouvelle formulation ou on fait d'abord entrer k*q2 et ensuite
    37933793                ! seulement on fait sortir k*q1 sans changement de composition
    37943794                ! isotopique
    … …  
    38283828           enddo ! do ixt = 1, ntraciso
    38293829        else !if (dq_tmp/rr(il,1).lt.-0.9) then
    3830                 ! formulation habituelle qui avait toujours marché de 2006 à
    3831                 ! décembre 2017.
     3830                ! formulation habituelle qui avait toujours marche de 2006 a
     3831                ! decembre 2017.
    38323832           do ixt = 1, ntraciso     
    38333833                fxt(ixt,il,1)=fxt(ixt,il,1) &
    … …  
    42324232        ! ad.
    42334233#endif
    4234        ! ici, on sépare 2 cas, pour éviter le cas pathologique décrit plus haut
    4235        ! pour la tendance liée à Am en i=1, qui peut conduire à des isotopes
    4236        ! négatifs dans les cas où les flux de masse soustrait plus de 90% de la
    4237        ! vapeur de la couche. Voir plus haut le détail des équations.
    4238        ! La différence ici est qu'on considère les flux de masse amp1 et ad en
    4239        ! même temps.
     4234       ! ici, on separe 2 cas, pour eviter le cas pathologique decrit plus haut
     4235       ! pour la tendance liee a Am en i=1, qui peut conduire a des isotopes
     4236       ! negatifs dans les cas ou les flux de masse soustrait plus de 90% de la
     4237       ! vapeur de la couche. Voir plus haut le detail des equations.
     4238       ! La difference ici est qu'on considere les flux de masse amp1 et ad en
     4239       ! meme temps.
    42404240       dq_tmp= 0.01*grav*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i)) &
    42414241    &            -ad(il)*(rr(il,i)-rr(il,i-1)))*delt
    4242        ! c'est équivalent à dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi
     4242       ! c'est equivalent a dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi
    42434243       if ((dq_tmp/rr(il,i).lt.-0.9).and.correction_excess_aberrant) then
    42444244        ! nouvelle formulation
    … …  
    44304430        ! on change le traitement de cette ligne le 8 mai 2009:
    44314431        ! avant, on avait: xtawat=xtelij(il,k,i)-(1.-xtep(il,i))*xtclw(il,i)
    4432         ! c'est à dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
    4433         ! si Relij!=Rclw, alors un fractionnement isotopique non physique était
     4432        ! c'est a dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
     4433        ! si Relij!=Rclw, alors un fractionnement isotopique non physique etait
    44344434        ! introduit.
    4435         ! En fait, awat représente le surplus de condensat dans le mélange par
    4436         ! rapport à celui restant dans la colonne adiabatique
    4437         ! ce surplus à la même compo que le elij, sans fractionnement.
    4438         ! d'où le nouveau traitement ci-dessous.
     4435        ! En fait, awat represente le surplus de condensat dans le melange par
     4436        ! rapport a celui restant dans la colonne adiabatique
     4437        ! ce surplus a la meme compo que le elij, sans fractionnement.
     4438        ! d'ou le nouveau traitement ci-dessous.
    44394439      if (elij(il,k,i).gt.0.0) then
    44404440        do ixt = 1, ntraciso
    44414441          xtawat(ixt)=awat*(xtelij(ixt,il,k,i)/elij(il,k,i))
    4442 !          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas nécessaire
     4442!          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
    44434443        enddo
    44444444      else !if (elij(il,k,i).gt.0.0) then
    44454445          ! normalement, si elij(il,k,i)<=0, alors awat=0
    4446           ! on le vérifie. Si c'est vrai -> xtawat=0 aussi
     4446          ! on le verifie. Si c'est vrai -> xtawat=0 aussi
    44474447#ifdef ISOVERIF
    44484448        call iso_verif_egalite(awat,0.0,'cv30_yield 3779')
    … …  
    49424942     &       'cv30_yield 5029,O18, evap')
    49434943          if ((il.eq.1636).and.(i.eq.9)) then
    4944             write(*,*) 'cv30_yield 5057: ici, on vérifie deltaD_nobx'
     4944            write(*,*) 'cv30_yield 5057: ici, on verifie deltaD_nobx'
    49454945            write(*,*) 'il,i=',il,i
    49464946            write(*,*) 'fr(il,i),bx,fr(il,i)-bx=',fr(il,i),bx,fr(il,i)-bx
    … …  
    49734973        else ! taggage des ddfts:
    49744974        ! la formule pour fq_ddft suppose que le ddft est en RP. Ce n'est pas le
    4975         ! cas pour le water tagging puisqu'il y a conversion des molécules
    4976         ! blances entrainées en molécule rouges.
     4975        ! cas pour le water tagging puisqu'il y a conversion des molecules
     4976        ! blances entrainees en molecule rouges.
    49774977        ! Il faut donc prendre en compte ce taux de conversion quand
    49784978        ! entrainement d'env vers ddft
    … …  
    49834983!     :           -conversion(iiso)   
    49844984
    4985         ! Pb: quand on discretise, dqp/dt n'est pas vérifée numériquement.
    4986         ! on se retrouve donc avec des d Ye/dt différents de 0 même si ye=0 ( on
    4987         ! note X les molécules poubelles et Y les molécules ddfts).
     4985        ! Pb: quand on discretise, dqp/dt n'est pas verifee numeriquement.
     4986        ! on se retrouve donc avec des d Ye/dt differents de 0 meme si ye=0 ( on
     4987        ! note X les molecules poubelles et Y les molecules ddfts).
    49884988
    49894989        ! Solution alternative: Dans le cas entrainant, Ye ne varie que par
    49904990        ! ascendance compensatoire des ddfts et par perte de Ye vers le ddft. On
    4991         ! calcule donc ce terme directement avec schéma amont:
    4992 
    4993         ! ajout déjà de l'évap
     4991        ! calcule donc ce terme directement avec schema amont:
     4992
     4993        ! ajout deja de l'evap
    49944994        do ixt = 1+niso,ntraciso
    49954995             fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    50695069#endif
    50705070                else !if (abs(dXe).gt.ridicule) then
    5071                     ! dans ce cas, fxtXe doit être faible
     5071                    ! dans ce cas, fxtXe doit etre faible
    50725072                   
    50735073#ifdef ISOVERIF
    … …  
    50855085                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    50865086                    else !if (izone.eq.izone_poubelle) then
    5087                         ! pas de tendance pour ce tag là
     5087                        ! pas de tendance pour ce tag la
    50885088                    endif !if (izone.eq.izone_poubelle) then
    50895089                   endif !if ((izone.ne.izone_revap).and.
    … …  
    50995099               
    51005100            else !if (mp(il,i).gt.mp(il,i+1)) then
    5101                 ! cas détrainant: pas de problèmes
     5101                ! cas detrainant: pas de problemes
    51025102                do ixt=1+niso,ntraciso
    51035103                fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    53895389  DO il = 1, ncum
    53905390
    5391 ! attention, on corrige un problème C Risi
     5391! attention, on corrige un probleme C Risi
    53925392      IF (cvflag_grav) then
    53935393
    … …  
    57225722!             write(*,*) 'cv30_routine 3990: fin des il pour i=',i
    57235723          enddo !do i=1,nl
    5724 !          write(*,*) 'cv30_routine 3990: fin des vérifs sur homogen'
     5724!          write(*,*) 'cv30_routine 3990: fin des verifs sur homogen'
    57255725#endif
    57265726
    … …  
    60276027
    60286028  ! fraction deau condensee dans les melanges convertie en precip : epm
    6029   ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
     6029  ! et eau condensee precipitee dans masse d'air sature : l_m*dM_m/dzdz.dzdz
    60306030  DO j = 1, nam1
    60316031    DO k = 1, j - 1
    … …  
    62266226
    62276227#ifdef ISOVERIF
    6228         write(*,*) 'cv30_routines 4293: entrée dans cv3_uncompress'
     6228        write(*,*) 'cv30_routines 4293: entree dans cv3_uncompress'
    62296229#endif
    62306230  DO i = 1, ncum
    … …  
    63466346
    63476347        ! On fait varier epmax en fn de la cape
    6348         ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
    6349         ! qui en dépend
    6350         ! Toutes les autres variables fn de ep sont calculées plus bas.
     6348        ! Il faut donc recalculer ep, et hp qui a deja ete calcule et
     6349        ! qui en depend
     6350        ! Toutes les autres variables fn de ep sont calculees plus bas.
    63516351
    63526352#include "cvthermo.h"

  • LMDZ6/trunk/libf/phylmdiso/cv3_routines.F90

    r4033 r4050  
    403403        enddo !do i=1,len
    404404#endif         
    405 ! initialiser quelques variables oubliées
     405! initialiser quelques variables oubliees
    406406       do i=1,len
    407407          plcllo(i)=0.0
    … …  
    900900          zfice(i) = MIN(MAX(zfice(i),0.0),1.0)         
    901901       enddo
    902        ! calcul de la composition du condensat glacé et liquide
     902       ! calcul de la composition du condensat glace et liquide
    903903
    904904       do i=1,len
    … …  
    959959
    960960#ifdef ISOVERIF
    961             write(*,*) 'cv3_routine undilute 1 598: après condiso'
     961            write(*,*) 'cv3_routine undilute 1 598: apres condiso'
    962962         
    963963          if (iso_eau.gt.0) then
    … …  
    14351435
    14361436!JAM--------------------------------------------------------------------
    1437 ! Calcul de la quantité d'eau sous forme de glace
     1437! Calcul de la quantite d'eau sous forme de glace
    14381438! --------------------------------------------------------------------
    14391439  INTEGER nl, len
    … …  
    28562856      real xtrti(ntraciso,nloc)
    28572857      real xtres(ntraciso)
    2858       ! on ajoute la dimension nloc à xtrti pour vérifs dans les tags: 5 fev
     2858      ! on ajoute la dimension nloc a xtrti pour verifs dans les tags: 5 fev
    28592859      ! 2010
    28602860      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
    … …  
    28732873#ifdef ISO
    28742874#ifdef ISOVERIF
    2875 !       write(*,*) 'cv3_routines 1820: entrée dans cv3_mixing'
     2875!       write(*,*) 'cv3_routines 1820: entree dans cv3_mixing'
    28762876       do i=minorig+1,nl
    28772877        do il=1,ncum
    … …  
    30833083!     :           'tcond(il),rs(il,j)=',
    30843084!     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
    3085         ! colorier la vapeur résiduelle selon température de
    3086         ! condensation, et le condensat en un tag spécifique
     3085        ! colorier la vapeur residuelle selon temperature de
     3086        ! condensation, et le condensat en un tag specifique
    30873087          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) then 
    30883088            if (option_traceurs.eq.17) then       
    … …  
    31943194#ifdef ISOTRAC         
    31953195        if (option_tmin.ge.1) then
    3196         ! colorier la vapeur résiduelle selon température de
    3197         ! condensation, et le condensat en un tag spécifique
     3196        ! colorier la vapeur residuelle selon temperature de
     3197        ! condensation, et le condensat en un tag specifique
    31983198!        write(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
    31993199!     :            il,i,j,xtent(:,il,i,j)
    … …  
    34313431#ifdef ISOTRAC         
    34323432        if (option_tmin.ge.1) then
    3433         ! colorier la vapeur résiduelle selon température de
    3434         ! condensation, et le condensat en un tag spécifique
     3433        ! colorier la vapeur residuelle selon temperature de
     3434        ! condensation, et le condensat en un tag specifique
    34353435!        write(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
    34363436!     :            il,i,j,xtent(:,il,i,j)
    … …  
    35433543#ifdef ISO
    35443544#ifdef ISOTRAC
    3545         ! seulement à la fin on taggue le condensat
     3545        ! seulement a la fin on taggue le condensat
    35463546        if (option_cond.ge.1) then
    35473547         do im = 1, nd
    35483548         do jm = 1, nd
    35493549         do il = 1, ncum   
    3550            ! colorier le condensat en un tag spécifique
     3550           ! colorier le condensat en un tag specifique
    35513551           do ixt=niso+1,ntraciso
    35523552             if (index_zone(ixt).eq.izone_cond) then
    … …  
    35673567         do im = 1, nd
    35683568         do il = 1, ncum   
    3569            ! colorier le condensat en un tag spécifique
     3569           ! colorier le condensat en un tag specifique
    35703570           do ixt=niso+1,ntraciso
    35713571             if (index_zone(ixt).eq.izone_cond) then
    … …  
    39913991        call iso_verif_traceur(xtwdtrain(1,il),'cv3_routine 2540')
    39923992        if (option_cond.ge.1) then
    3993           ! on vérifie que tout le détrainement est taggé condensat
     3993          ! on verifie que tout le detrainement est tagge condensat
    39943994          if (iso_verif_positif_nostop( &
    39953995     &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
    … …  
    41564156!!---end jyg---
    41574157
    4158 ! --------retour à la formulation originale d'Emanuel.
     4158! --------retour a la formulation originale d'Emanuel.
    41594159        IF (cvflag_ice) THEN
    41604160
    … …  
    41704170
    41714171!JAM  Attention: evap=sigt*E
    4172 !    Modification: evap devient l'évaporation en milieu de couche
    4173 !    car nécessaire dans cv3_yield
    4174 !    Du coup, il faut modifier pas mal d'équations...
     4172!    Modification: evap devient l'evaporation en milieu de couche
     4173!    car necessaire dans cv3_yield
     4174!    Du coup, il faut modifier pas mal d'equations...
    41754175!    et l'expression de afac qui devient afac1
    41764176!    revap=sqrt((prec(i+1)+prec(i))/2)
    … …  
    41914191!JYG    Dans sa formulation originale, Emanuel calcule l'evaporation par:
    41924192! c             evap(il,i)=sigt*afac*revap
    4193 ! ce qui n'est pas correct. Dans cv_routines, la formulation a été modifiee.
     4193! ce qui n'est pas correct. Dans cv_routines, la formulation a ete modifiee.
    41944194! Ici,l'evaporation evap est simplement calculee par l'equation de
    41954195! conservation.
    … …  
    45254525#ifdef ISO
    45264526#ifdef ISOVERIF
    4527 ! verif des inputs à appel stewart
     4527! verif des inputs a appel stewart
    45284528      do il=1,ncum
    45294529       if (i.le.inb(il) .and. lwork(il)) then
    … …  
    45434543       enddo
    45444544#endif
    4545         ! appel de appel_stewart_vectorisé
     4545        ! appel de appel_stewart_vectorise
    45464546        call appel_stewart_vectall_np(lwork,ncum, &
    45474547     &                   ph,t,evap,xtwdtrain, &
    … …  
    46114611#endif
    46124612       
    4613 ! équivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
     4613! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
    46144614       do il=1,ncum
    46154615        if (i.lt.inb(il) .and. lwork(il)) then
    … …  
    46514651#endif
    46524652          rpprec(il,i)=rs(il,i)     
    4653          ! sous cas rajouté le 11dec 2011. Normalement, pas utile
     4653         ! sous cas rajoute le 11dec 2011. Normalement, pas utile
    46544654         else if (rp(il,i).eq.0.0) then                 
    46554655            do ixt=1,ntraciso
    … …  
    48644864      real xtbx(ntraciso), xtawat(ntraciso,nloc)
    48654865      ! cam debug
    4866       ! pour l'homogénéisation sous le nuage:
     4866      ! pour l'homogeneisation sous le nuage:
    48674867      real bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
    48684868#ifdef DIAGISO
    4869         ! diagnostiques juste: tendance des différents processus
     4869        ! diagnostiques juste: tendance des differents processus
    48704870      real fxt_detrainement(niso,nloc,nd)
    48714871      real fxt_fluxmasse(niso,nloc,nd)
    … …  
    49174917#ifdef ISO
    49184918       ! cam debug
    4919 !       write(*,*) 'cv3_routines 3082: entrée dans cv3_yield'
     4919!       write(*,*) 'cv3_routines 3082: entree dans cv3_yield'
    49204920       ! en cam debug
    49214921       do ixt = 1, ntraciso
    … …  
    49944994  END DO
    49954995#ifdef ISO
    4996 ! on initialise mieux fr et fxt par securité
     4996! on initialise mieux fr et fxt par securite
    49974997  fr(:,:)=0.0
    49984998  fxt(:,:,:)=0.0
    … …  
    58455845        else ! taggage des ddfts:
    58465846        ! la formule pour fq_ddft suppose que le ddft est en RP. Ce n'est pas le
    5847         ! cas pour le water tagging puisqu'il y a conversion des molécules
    5848         ! blances entrainées en molécule rouges.
     5847        ! cas pour le water tagging puisqu'il y a conversion des molecules
     5848        ! blances entrainees en molecule rouges.
    58495849        ! Il faut donc prendre en compte ce taux de conversion quand
    58505850        ! entrainement d'env vers ddft
    … …  
    58555855!     :           -conversion(iiso)   
    58565856
    5857         ! Pb: quand on discretise, dqp/dt n'est pas vérifée numériquement.
    5858         ! on se retrouve donc avec des d Ye/dt différents de 0 même si ye=0 ( on
    5859         ! note X les molécules poubelles et Y les molécules ddfts).
     5857        ! Pb: quand on discretise, dqp/dt n'est pas verifee numeriquement.
     5858        ! on se retrouve donc avec des d Ye/dt differents de 0 meme si ye=0 ( on
     5859        ! note X les molecules poubelles et Y les molecules ddfts).
    58605860
    58615861        ! Solution alternative: Dans le cas entrainant, Ye ne varie que par
    58625862        ! ascendance compensatoire des ddfts et par perte de Ye vers le ddft. On
    5863         ! calcule donc ce terme directement avec schéma amont:
    5864 
    5865         ! ajout déjà de l'évap
     5863        ! calcule donc ce terme directement avec schema amont:
     5864
     5865        ! ajout deja de l'evap
    58665866        do ixt = 1+niso,ntraciso
    58675867             fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    59415941#endif
    59425942                else !if (abs(dXe).gt.ridicule) then
    5943                     ! dans ce cas, fxtXe doit être faible
     5943                    ! dans ce cas, fxtXe doit etre faible
    59445944                   
    59455945#ifdef ISOVERIF
    … …  
    59575957                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    59585958                    else !if (izone.eq.izone_poubelle) then
    5959                         ! pas de tendance pour ce tag là
     5959                        ! pas de tendance pour ce tag la
    59605960                    endif !if (izone.eq.izone_poubelle) then
    59615961                   endif !if ((izone.ne.izone_revap).and.
    … …  
    59715971               
    59725972            else !if (mp(il,i).gt.mp(il,i+1)) then
    5973                 ! cas détrainant: pas de problèmes
     5973                ! cas detrainant: pas de problemes
    59745974                do ixt=1+niso,ntraciso
    59755975                fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    61766176        ! on change le traitement de cette ligne le 8 mai 2009:
    61776177        ! avant, on avait: xtawat=xtelij(il,k,i)-(1.-xtep(il,i))*xtclw(il,i)
    6178         ! c'est à dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
    6179         ! si Relij!=Rclw, alors un fractionnement isotopique non physique était
     6178        ! c'est a dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
     6179        ! si Relij!=Rclw, alors un fractionnement isotopique non physique etait
    61806180        ! introduit.
    6181         ! En fait, awat représente le surplus de condensat dans le mélange par
    6182         ! rapport à celui restant dans la colonne adiabatique
    6183         ! ce surplus à la même compo que le elij, sans fractionnement.
    6184         ! d'où le nouveau traitement ci-dessous.
     6181        ! En fait, awat represente le surplus de condensat dans le melange par
     6182        ! rapport a celui restant dans la colonne adiabatique
     6183        ! ce surplus a la meme compo que le elij, sans fractionnement.
     6184        ! d'ou le nouveau traitement ci-dessous.
    61856185      if (elij(il,k,i).gt.0.0) then
    61866186        do ixt = 1, ntraciso
    61876187          xtawat(ixt,il)=awat(il)*(xtelij(ixt,il,k,i)/elij(il,k,i))
    6188 !          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas nécessaire
     6188!          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
    61896189        enddo !do ixt = 1, ntraciso
    61906190      else !if (elij(il,k,i).gt.0.0) then
    61916191          ! normalement, si elij(il,k,i)<=0, alors awat=0
    6192           ! on le vérifie. Si c'est vrai -> xtawat=0 aussi
     6192          ! on le verifie. Si c'est vrai -> xtawat=0 aussi
    61936193#ifdef ISOVERIF
    61946194        call iso_verif_egalite(awat(il),0.0,'cv3_yield 3779')
    … …  
    68506850        fq_detrainement(il, i) = fq_detrainement(il, i)/alpha_qpos(il)
    68516851        do ixt=1,ntraciso
    6852           fq_ddft(ixt,il, i) = fq_ddft(ixt,il, i)/alpha_qpos(il)
    6853           fq_evapprecip(ixt,il, i) = fq_evapprecip(ixt,il, i)/alpha_qpos(il)
    6854           fq_fluxmasse(ixt,il, i) = fq_fluxmasse(ixt,il, i)/alpha_qpos(il)
    6855           fq_detrainement(ixt,il, i) = fq_detrainement(ixt,il, i)/alpha_qpos(il)
     6852          fxt_ddft(ixt,il, i) = fxt_ddft(ixt,il, i)/alpha_qpos(il)
     6853          fxt_evapprecip(ixt,il, i) = fxt_evapprecip(ixt,il, i)/alpha_qpos(il)
     6854          fxt_fluxmasse(ixt,il, i) = fxt_fluxmasse(ixt,il, i)/alpha_qpos(il)
     6855          fxt_detrainement(ixt,il, i) = fxt_detrainement(ixt,il, i)/alpha_qpos(il)
    68566856        enddo ! do ixt=1,ntraciso
    68576857#endif       
    … …  
    71797179    ENDDO       ! k
    71807180
    7181 ! 14/01/15 AJ delta n'a rien à faire là...                                                 
     7181! 14/01/15 AJ delta n'a rien a faire la...                                                 
    71827182    DO il = 1, ncum                                                  ! cld
    71837183!!      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) &                         ! cld
    … …  
    71957195
    71967196! IM cf. FH
    7197 ! 14/01/15 AJ ne correspond pas à ce qui a été codé par JYG et SB           
     7197! 14/01/15 AJ ne correspond pas a ce qui a ete code par JYG et SB           
    71987198                                                         
    71997199      IF (iflag_clw==0) THEN                                         ! cld
    … …  
    72907290
    72917291! fraction deau condensee dans les melanges convertie en precip : epm
    7292 ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
     7292! et eau condensee precipitee dans masse d'air sature : l_m*dM_m/dzdz.dzdz
    72937293  DO j = 1, nl
    72947294    DO k = 1, nl
    … …  
    75767576
    75777577        ! On fait varier epmax en fn de la cape
    7578         ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
    7579         ! qui en dépend
    7580         ! Toutes les autres variables fn de ep sont calculées plus bas.
     7578        ! Il faut donc recalculer ep, et hp qui a deja ete calcule et
     7579        ! qui en depend
     7580        ! Toutes les autres variables fn de ep sont calculees plus bas.
    75817581
    75827582  include "cvthermo.h"
    … …  
    76137613
    76147614        ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne
    7615         ! connait pas ep, on ne connait pas les mélanges, ddfts etc... qui sont
     7615        ! connait pas ep, on ne connait pas les melanges, ddfts etc... qui sont
    76167616        ! necessaires au calcul de la cape dans la nouvelle physique
    76177617       

  • LMDZ6/trunk/libf/phylmdiso/infotrac_phy.F90

    r4048 r4050  
    5151  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    5252!$OMP THREADPRIVATE(niadv)
    53 
    54 ! CRisi: tableaux de fils
    55   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    56   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
    57   INTEGER, SAVE :: nqdesc_tot
    58   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    59   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
    60 !$OMP THREADPRIVATE(nqfils,nqdesc,nqdesc_tot,iqfils,iqpere)
    6153
    6254! conv_flg(it)=0 : convection desactivated for tracer number it
    … …  
    8476    INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    8577!$OMP THREADPRIVATE(iqiso)
    86     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
    87 !$OMP THREADPRIVATE(iso_num)
    8878    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
    8979!$OMP THREADPRIVATE(iso_indnum)
    90     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
    91 !$OMP THREADPRIVATE(zone_num)
    92     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
    93 !$OMP THREADPRIVATE(phase_num)
    9480    INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
    9581!$OMP THREADPRIVATE(indnum_fn_num)
    … …  
    10692  SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tracers_,type_trac_,&
    10793                               niadv_,conv_flg_,pbl_flg_,solsym_,&
    108                                nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,&
    10994                               ok_isotopes_,ok_iso_verif_,ok_isotrac_,&
    11095                               ok_init_iso_,niso_possibles_,tnat_,&
    111                                alpha_ideal_,use_iso_,iqiso_,iso_num_,&
    112                                iso_indnum_,zone_num_,phase_num_,&
     96                               alpha_ideal_,use_iso_,iqiso_,iso_indnum_,&
    11397                               indnum_fn_num_,index_trac_,&
    11498                               niso_,ntraceurs_zone_,ntraciso_,itr_indice_&
    … …  
    143127    CHARACTER(len=*),INTENT(IN) :: solsym_(nbtr_)
    144128    ! Isotopes:
    145     INTEGER,INTENT(IN) :: nqfils_(nqtot_)
    146     INTEGER,INTENT(IN) :: nqdesc_(nqtot_)
    147     INTEGER,INTENT(IN) :: nqdesc_tot_
    148     INTEGER,INTENT(IN) :: iqfils_(nqtot_,nqtot_)
    149     INTEGER,INTENT(IN) :: iqpere_(nqtot_)
    150129    LOGICAL,INTENT(IN) :: ok_isotopes_
    151130    LOGICAL,INTENT(IN) :: ok_iso_verif_
    … …  
    157136    LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_)
    158137    INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_)
    159     INTEGER,INTENT(IN) :: iso_num_(nqtot_)
    160138    INTEGER,INTENT(IN) :: iso_indnum_(nqtot_)
    161     INTEGER,INTENT(IN) :: zone_num_(nqtot_)
    162     INTEGER,INTENT(IN) :: phase_num_(nqtot_)
    163139    INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_)
    164140    INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_)
    … …  
    216192   
    217193    IF (ok_isotopes) THEN
    218       ALLOCATE(nqfils(nqtot))
    219       nqfils(:)=nqfils_(:)
    220       ALLOCATE(nqdesc(nqtot))
    221       nqdesc(:)=nqdesc_(:)
    222       nqdesc_tot=nqdesc_tot_
    223       ALLOCATE(iqfils(nqtot,nqtot))
    224       iqfils(:,:)=iqfils_(:,:)
    225       ALLOCATE(iqpere(nqtot))
    226       iqpere(:)=iqpere_(:)
    227    
    228194      tnat(:)=tnat_(:)
    229195      alpha_ideal(:)=alpha_ideal_(:)
    … …  
    232198      ALLOCATE(iqiso(ntraciso,nqo))
    233199      iqiso(:,:)=iqiso_(:,:)
    234       ALLOCATE(iso_num(nqtot))
    235       iso_num(:)=iso_num_(:)
    236200      ALLOCATE(iso_indnum(nqtot))
    237201      iso_indnum(:)=iso_indnum_(:)
    238       ALLOCATE(zone_num(nqtot))
    239       zone_num(:)=zone_num_(:)
    240       ALLOCATE(phase_num(nqtot))
    241       phase_num(:)=phase_num_(:)
    242202     
    243203      indnum_fn_num(:)=indnum_fn_num_(:)
    … …  
    255215        write(*,*) 'itr_indice=',itr_indice
    256216#ifdef ISOVERIF
    257         write(*,*) 'iso_num=',iso_num
     217        write(*,*) 'iso_iName=',tracers(:)%iso_iName
    258218#endif
    259219 

  • LMDZ6/trunk/libf/phylmdiso/isotopes_verif_mod.F90

    r4033 r4050  
    21232123       end function iso_verif_tracdD_choix_nostop
    21242124
    2125        subroutine iso_verif_trac17_q_deltaD(x,err_msg)
    2126         use isotrac_mod, only: nzone_temp,option_traceurs
    2127         USE infotrac_phy, ONLY: ntraciso
    2128        implicit none
    2129 
    2130         ! inputs
    2131         real x(ntraciso)
    2132         character*(*) err_msg
    2133         ! local
    2134         integer iso_verif_tag17_q_deltaD_chns
    2135 
    2136        if ((option_traceurs.eq.17).or. &
    2137      &           (option_traceurs.eq.18)) then
    2138        if (nzone_temp.ge.5) then
    2139           if (iso_verif_tag17_q_deltaD_chns(x,err_msg).eq.1) then
    2140                 stop
    2141           endif
    2142         endif
    2143         endif !if (option_traceurs.eq.17) then
    2144 
    2145         end subroutine iso_verif_trac17_q_deltaD
     2125INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
     2126  USE infotrac_phy, ONLY: index_trac, ntraciso
     2127  USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
     2128  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
     2129  IMPLICIT NONE
     2130  REAL,             INTENT(IN) :: x(ntraciso)
     2131  CHARACTER(LEN=*), INTENT(IN) :: err_msg
     2132  INTEGER :: ieau, ixt, ieau1
     2133  res = 0
     2134  IF(ALL([17,18]/=option_traceurs)) RETURN
     2135  !--- Check whether * deltaD(highest tagging layer) < 200 permil
     2136  !                  * q <
     2137  ieau=index_trac(nzone_temp,iso_eau)
     2138  ixt=index_trac(nzone_temp,iso_HDO)
     2139  IF(x(ieau)>ridicule) THEN
     2140    IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
     2141      res=1; write(*,*) 'x=',x
     2142    END IF
     2143  END IF
     2144  IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
     2145    res=1; write(*,*) 'x=',x
     2146  END IF
     2147  !--- Check whether q is small ; then, qt01 < 10%
     2148  IF(x(iso_eau)<2.0e-3) THEN
     2149    ieau1= index_trac(1,iso_eau)
     2150    IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
     2151      res=1; write(*,*) 'x=',x
     2152    END IF
     2153  END IF
     2154END FUNCTION iso_verif_tag17_q_deltaD_chns
     2155
     2156SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
     2157  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
     2158  USE infotrac_phy, ONLY: ntraciso
     2159  IMPLICIT NONE
     2160  REAL,             INTENT(IN) :: x(ntraciso)
     2161  CHARACTER(LEN=*), INTENT(IN) :: err_msg
     2162  IF(ALL([17,18]/=option_traceurs)) RETURN
     2163  IF(nzone_temp>=5) THEN
     2164    IF(iso_verif_tag17_q_deltaD_chns(x,err_msg)==1) STOP
     2165  END IF
     2166END SUBROUTINE iso_verif_trac17_q_deltaD
    21462167
    21472168      subroutine iso_verif_traceur(x,err_msg)
    … …  
    26762697       
    26772698        end function iso_verif_traceur_jm_nostop
    2678 
    2679         function iso_verif_tag17_q_deltaD_chns(x,err_msg)
    2680         USE infotrac_phy, ONLY: index_trac,ntraciso
    2681         use isotopes_mod, ONLY: iso_HDO,iso_eau,ridicule
    2682         use isotrac_mod, only: nzone_temp,option_traceurs
    2683         implicit none
    2684 
    2685         ! inputs
    2686         real x(ntraciso)
    2687         character*(*) err_msg
    2688         ! output
    2689         integer iso_verif_tag17_q_deltaD_chns
    2690         ! locals
    2691         !integer iso_verif_positif_nostop
    2692         !real deltaD
    2693         integer ieau,ixt,ieau1
    2694 
    2695         iso_verif_tag17_q_deltaD_chns=0
    2696 
    2697         if ((option_traceurs.eq.17).or. &
    2698      &           (option_traceurs.eq.18)) then
    2699         ! verifier que deltaD du tag de la couche la plus haute <
    2700         ! 200 permil, et vérifier que son q est inférieur à
    2701         ieau=index_trac(nzone_temp,iso_eau)
    2702         ixt=index_trac(nzone_temp,iso_HDO)
    2703 
    2704         if (x(ieau).gt.ridicule) then
    2705           if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), &
    2706      &           err_msg//': deltaDt05 trop fort').eq.1) then
    2707                 write(*,*) 'x=',x
    2708                 iso_verif_tag17_q_deltaD_chns=1
    2709           endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
    2710         endif !if (x(ieau).gt.ridicule) then
    2711 
    2712         if (iso_verif_positif_nostop(2.0e-3-x(ieau), &
    2713      &           err_msg//': qt05 trop fort').eq.1) then
    2714                 write(*,*) 'x=',x
    2715                 iso_verif_tag17_q_deltaD_chns=1
    2716         endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
    2717 
    2718         ! on vérifie que si q est petit, alors qt01 fait moins de 10%
    2719         if (x(iso_eau).lt.2.0e-3) then
    2720            ieau1= index_trac(1,iso_eau)
    2721            if (iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)), &
    2722      &            err_msg//': qt01 trop abondant').eq.1) then
    2723              write(*,*) 'x=',x
    2724                 iso_verif_tag17_q_deltaD_chns=1
    2725            endif ! if (iso_verif_positif(0.1-(x(ixt)/x(ieau)),
    2726         endif !if (x(ieau).lt.2.0e-3) then
    2727 
    2728         endif !if (option_traceurs.eq.17) then
    2729 
    2730         end function iso_verif_tag17_q_deltaD_chns
    27312699
    27322700        subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)

  • LMDZ6/trunk/libf/phylmdiso/phyetat0.F90

    r4046 r4050  
    4545  use config_ocean_skin_m, only: activate_ocean_skin
    4646#ifdef ISO
    47   USE infotrac_phy, ONLY: ntraciso,niso,iso_num
     47  USE infotrac_phy, ONLY: niso
    4848  USE isotopes_routines_mod, ONLY: phyisoetat0
    4949  USE isotopes_mod, ONLY: iso_eau

  • LMDZ6/trunk/libf/phylmdiso/phys_output_mod.F90

    r4048 r4050  
    3535    USE iophy
    3636    USE dimphy
    37     USE infotrac_phy, ONLY: nqtot, nqo, niadv, tracers, type_trac, &
     37    USE infotrac_phy, ONLY: nqtot, nqo, niadv, tracers, type_trac, maxlen, &
    3838        nqtottr,itr_indice ! C Risi
    39     USE strings_mod,  ONLY: maxlen
    4039    USE ioipsl
    4140    USE phys_cal_mod, only : hour, calend
    … …  
    537536        write(lunout,*) 'itr_indice=',itr_indice
    538537!       IF (nqtot>=nqo+1) THEN
    539          IF (nqtottr>=1) THEN
    540538!
    541539            !DO iq=nqo+1,nqtot
    … …  
    579577            tnam = 'cum'//TRIM(tracers(iiq)%name); o_trac_cum(itr)= ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    580578          ENDDO
    581        ENDIF
    582579
    583580   ENDDO !  iff

  • LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90

    r4040 r4050  
    123123#ifdef ISO
    124124    USE infotrac_phy, ONLY:  &
    125         iqiso,iso_num,iso_indnum,zone_num,ok_isotrac, &
     125        iqiso,iso_indnum,tracers,ok_isotrac, &
    126126        niso,ntraciso,nqtottr,itr_indice ! ajout C Risi pour isos
    127127     USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO, &
    … …  
    141141        & iso_verif_aberrant_choix,iso_verif_positif, &
    142142        & iso_verif_positif_choix_vect,iso_verif_o18_aberrant_nostop, &
    143         & iso_verif_init, &
     143        & iso_verif_init,&
    144144        & iso_verif_positif_strict_nostop,iso_verif_O18_aberrant_enc_vect2D
    145145#endif
    … …  
    155155&       iso_verif_traceur_justmass,iso_verif_traceur_vect, &
    156156&       iso_verif_trac17_q_deltad,iso_verif_trac_masse_vect, &
    157 &       iso_verif_tracpos_choix_nostop
     157&       iso_verif_tag17_q_deltaD_vect, iso_verif_tracpos_choix_nostop
    158158#endif
    159159#endif
    … …  
    23662366#endif
    23672367      if (ixt.gt.niso) then
    2368       write(*,*) 'izone,iiso=',zone_num(iqiso(ixt,ivap)),iso_indnum(iqiso(ixt,ivap)) 
     2368      write(*,*) 'izone,iiso=',tracers(iqiso(ixt,ivap))%iso_iZone,iso_indnum(iqiso(ixt,ivap)) 
    23692369      endif
    23702370      DO k = 1, klev
Note: See TracChangeset for help on using the changeset viewer.