Ignore:
Timestamp:
Dec 6, 2022, 12:01:16 AM (3 years ago)
Author:
lguez
Message:

Sync latest trunk changes to Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
8 deleted
39 edited
11 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/add_phys_tend_mod.F90

    r4004 r4368  
    3939  USE mod_grid_phy_lmdz, ONLY: nbp_lev
    4040#ifdef ISO
    41   USE infotrac_phy, ONLY: ntraciso
     41  USE infotrac_phy, ONLY: ntraciso=>ntiso
    4242  USE isotopes_mod, ONLY: iso_eau
    4343#endif
    … …  
    154154
    155155#ifdef ISO
    156     USE infotrac_phy, ONLY: ntraciso 
     156    USE infotrac_phy, ONLY: ntraciso=>ntiso
    157157#ifdef ISOVERIF
    158158    USE isotopes_mod, ONLY: iso_eau

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/add_wake_tend.F90

    r4004 r4368  
    1818USE print_control_mod, ONLY: prt_level
    1919#ifdef ISO
    20     USE infotrac_phy, ONLY: ntraciso   
     20    USE infotrac_phy, ONLY: ntiso   
    2121    USE phys_state_var_mod, ONLY:  wake_deltaxt   
    2222#endif
    … …  
    3131  INTEGER,                       INTENT (IN)         :: abortphy
    3232#ifdef ISO
    33   REAL, DIMENSION(ntraciso,klon, klev),   INTENT (IN)         :: zddeltaxt
     33  REAL, DIMENSION(ntiso, klon, klev), INTENT (IN)    :: zddeltaxt
    3434#endif
    3535
    … …  
    6161               wake_deltaq(i, l) = wake_deltaq(i, l) + zddeltaq(i,l)
    6262#ifdef ISO
    63                do ixt=1,ntraciso
     63               do ixt=1,ntiso
    6464                 wake_deltaxt(ixt,i, l) = wake_deltaxt(ixt,i, l) + zddeltaxt(ixt,i,l)
    6565               enddo
    … …  
    6969               wake_deltaq(i, l) = 0.
    7070#ifdef ISO
    71                do ixt=1,ntraciso
     71               do ixt=1,ntiso
    7272                 wake_deltaxt(ixt,i, l) = 0.0
    7373               enddo

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/ajsec.F90

    r4004 r4368  
    99  USE dimphy
    1010#ifdef ISO
    11     USE infotrac_phy, ONLY: ntraciso    
     11    USE infotrac_phy, ONLY: ntraciso =>ntiso   
    1212#ifdef ISOVERIF
    1313  USE isotopes_mod, ONLY : iso_eau,iso_HDO
    … …  
    303303  USE dimphy
    304304#ifdef ISO
    305     USE infotrac_phy, ONLY: ntraciso      
     305    USE infotrac_phy, ONLY: ntraciso=>ntiso   
    306306#ifdef ISOVERIF
    307307  USE isotopes_mod, ONLY : iso_eau,iso_HDO

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/calwake.F90

    r4004 r4368  
    3535  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
    3636#ifdef ISO
    37   USE infotrac_phy, ONLY : ntraciso
     37  USE infotrac_phy, ONLY : ntraciso=>ntiso
    3838#ifdef ISOVERIF
    3939  USE isotopes_mod, ONLY: iso_eau
    … …  
    140140  REAL                                               :: rdcp
    141141
    142 #ifdef ISOVERIF       
    143         write(*,*) 'calwake 143 tmp: wake_deltaq(419,1)=',wake_deltaq(419,1)
    144         write(*,*) 'wake_deltaxt(iso_eau,419,1)=',wake_deltaxt(iso_eau,419,1)
    145 #endif
    146142  IF (prt_level >= 10) THEN
    147143    print *, '-> calwake, wake_s, wgen input ', wake_s(1), wgen(1)

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/change_srf_frac_mod.F90

    r4004 r4368  
    3939    USE print_control_mod, ONLY: lunout
    4040#ifdef ISO
    41   USE infotrac_phy, ONLY: ntraciso   
     41  USE infotrac_phy, ONLY: ntiso   
    4242#endif
    4343   
    … …  
    6666!albedo SB <<<
    6767#ifdef ISO
    68     REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT)        :: xtevap
     68    REAL, DIMENSION(ntiso,klon,nbsrf), INTENT(INOUT)        :: xtevap
    6969#endif
    7070

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/climb_hq_mod.F90

    r4004 r4368  
    66  USE dimphy
    77#ifdef ISO
    8   USE infotrac_phy, ONLY: ntraciso ! ajout C Risi pour isos     
     8  USE infotrac_phy, ONLY: ntraciso=>ntiso ! ajout C Risi pour isos     
    99#endif
    1010
    … …  
    5959            )
    6060#ifdef ISOVERIF
    61 !USE infotrac_phy, ONLY: use_iso
    6261USE isotopes_mod, ONLY: iso_eau,iso_HDO
    6362!USE isotopes_verif_mod, ONLY: errmax, errmaxrel
    … …  
    502501
    503502#ifdef ISOVERIF
    504 USE infotrac_phy, ONLY: ok_isotrac
     503USE infotrac_phy, ONLY: nzone
    505504USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18, ridicule
    506505USE isotopes_verif_mod
    … …  
    578577         endif
    579578#ifdef ISOTRAC
    580          if (ok_isotrac) then
    581            call iso_verif_traceur(xt_old(1,i,k),'climb_hq_mod 422')
    582          endif
     579         IF(nzone > 0) CALL iso_verif_traceur(xt_old(1,i,k),'climb_hq_mod 422')
    583580#endif
    584581        enddo
    … …  
    781778        endif
    782779#ifdef ISOTRAC
    783         if (ok_isotrac) then
    784            call iso_verif_traceur(xt_old(1,i,k),'climb_hq_mod 526')
    785         endif
     780        IF(nzone > 0) CALL iso_verif_traceur(xt_old(1,i,k),'climb_hq_mod 526')
    786781#endif       
    787782#endif       

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/concvl.F90

    r4004 r4368  
    4444  USE infotrac_phy, ONLY: nbtr
    4545#ifdef ISO
    46   USE infotrac_phy, ONLY: ntraciso
     46  USE infotrac_phy, ONLY: ntraciso=>ntiso
    4747  USE isotopes_mod, ONLY: iso_eau, bidouille_anti_divergence, ridicule, &
    4848        iso_eau,iso_HDO

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv30_routines.F90

    r4004 r4368  
    165165    )
    166166#ifdef ISO
    167     USE infotrac_phy, ONLY: ntraciso   
     167    USE infotrac_phy, ONLY: ntraciso=>ntiso
    168168#endif
    169169  IMPLICIT NONE
    … …  
    370370
    371371#ifdef ISO
    372 USE infotrac_phy, ONLY: ntraciso
     372USE infotrac_phy, ONLY: ntraciso=>ntiso
    373373USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
    374374        iso_eau,iso_HDO, ridicule
    … …  
    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
    … …  
    947947  USE print_control_mod, ONLY: lunout
    948948#ifdef ISO
    949     use infotrac_phy, ONLY: ntraciso
     949    use infotrac_phy, ONLY: ntraciso=>ntiso
    950950    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
    951951#ifdef ISOVERIF
    … …  
    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
    … …  
    11331133    ! epmax_cape: ajout arguments
    11341134#ifdef ISO
    1135 use infotrac_phy, ONLY: ntraciso
     1135use infotrac_phy, ONLY: ntraciso=>ntiso
    11361136USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, iso_eau,iso_HDO
    11371137USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
    … …  
    18281828
    18291829#ifdef ISO
    1830 use infotrac_phy, ONLY: ntraciso,niso,index_trac
     1830use infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
    18311831USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, &
    18321832        ridicule
    … …  
    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
    … …  
    26162616        call iso_verif_traceur(xtclw(1,il,im), &
    26172617     &          'condiso_liq_ice_vectiso_trac 358')
    2618         if (iso_verif_positif_nostop(xtclw(index_trac( &
     2618        if (iso_verif_positif_nostop(xtclw(itZonIso( &
    26192619     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    26202620     &           ,'cv30_routines 909').eq.1) then
    … …  
    26242624     &             niso,ntraciso,index_zone,izone_cond       
    26252625               stop
    2626          endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     2626         endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    26272627#endif             
    26282628         enddo !do il = 1, ncum   
    … …  
    26472647     &          )
    26482648#ifdef ISO
    2649     use infotrac_phy, ONLY: ntraciso
     2649    use infotrac_phy, ONLY: ntraciso=>ntiso
    26502650    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule
    26512651    use isotopes_routines_mod, ONLY: appel_stewart_vectall
    … …  
    26592659#ifdef ISOTRAC
    26602660    use isotrac_mod, only: option_cond,izone_cond
    2661     use infotrac_phy, ONLY: index_trac
     2661    use infotrac_phy, ONLY: itZonIso
    26622662#ifdef ISOVERIF
    26632663    use isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
    … …  
    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( &
    2940      &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
     2940     &          xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
    29412941     &          -xtwdtrain(iso_eau,il), &
    29422942     &          'cv30_routines 2795').eq.1) then
    … …  
    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
    … …  
    32003200!        if (option_tmin.ge.1) then
    32013201!           call iso_verif_positif(xtwater(
    3202 !     :           index_trac(izone_cond,iso_eau),il,i+1)
     3202!     :           itZonIso(izone_cond,iso_eau),il,i+1)
    32033203!     :           -xtwater(iso_eau,il,i+1),
    32043204!     :          'cv30_routines 3083')
    … …  
    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, &
    … …  
    32593259!        if (option_tmin.ge.1) then
    32603260!         call iso_verif_positif(xtwater(
    3261 !     :           index_trac(izone_cond,iso_eau),il,i)
     3261!     :           itZonIso(izone_cond,iso_eau),il,i)
    32623262!     :           -xtwater(iso_eau,il,i),
    32633263!     :          'cv30_routines 3143')
    … …  
    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
    … …  
    33693369     &                    )
    33703370#ifdef ISO
    3371     use infotrac_phy, ONLY: ntraciso,niso, &
    3372 &       ntraceurs_zone,index_trac
     3371    use infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
    33733372    use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
    33743373#ifdef ISOVERIF
    … …  
    34633462      real xtbx(ntraciso), xtawat(ntraciso)
    34643463      ! cam debug
    3465       ! pour l'homogénéisation sous le nuage:
     3464      ! pour l'homogeneisation sous le nuage:
    34663465      real frsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
    3467       ! correction dans calcul tendance liée à Am:
     3466      ! correction dans calcul tendance liee a Am:
    34683467      real dq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp
    34693468      logical correction_excess_aberrant
    34703469      parameter (correction_excess_aberrant=.false.)
    3471         ! correction qui permettait d'éviter deltas et dexcess aberrants. Mais
     3470        ! correction qui permettait d'eviter deltas et dexcess aberrants. Mais
    34723471        ! pb: ne conserve pas la masse d'isotopes!
    34733472#ifdef DIAGISO
    3474         ! diagnostiques juste: tendance des différents processus
     3473        ! diagnostiques juste: tendance des differents processus
    34753474      real fxt_detrainement(ntraciso,nloc,nd)
    34763475      real fxt_fluxmasse(ntraciso,nloc,nd)
    … …  
    35173516#ifdef ISO
    35183517       ! cam debug
    3519 !       write(*,*) 'cv30_routines 3082: entrée dans cv3_yield'
     3518!       write(*,*) 'cv30_routines 3082: entree dans cv3_yield'
    35203519       ! en cam debug
    35213520       do ixt = 1, ntraciso
    … …  
    37493748        do ixt = 1, ntraciso
    37503749!        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
     3750!     &      +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) ! deplace
     3751!     plus haut car il existe differents cas
    37533752        fxt_ddft(ixt,il,1)=fxt_ddft(ixt,il,1) &
    37543753     &      +0.01*grav*mp(il,2)*(xtp(ixt,il,2)-xt(ixt,il,1))*work(il)
    … …  
    37593758
    37603759
    3761         ! pour l'ajout de la tendance liée au flux de masse Am, il faut être
     3760        ! pour l'ajout de la tendance liee au flux de masse Am, il faut etre
    37623761        ! prudent.
    37633762        ! 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:
     3763        ! Pour les isotopes, la formule utilisee depuis 2006 et qui avait toujours marche est:
    37653764        ! 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.
     3765        ! Mais on plante dans un cas pathologique en decembre 2017 lors du test
     3766        ! d'un cas d'Anne Cozic: les isotopes deviennent negatifs.
    37683767        ! C'est un cas pas physique: on perd 99% de la masse de vapeur d'eau!
    37693768        ! 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
     3769        ! et dq=-1.24e-3: comment est-ce possible qu'un flux venant d'un air a
     3770        ! q2= 1.01e-3 asseche q1 jusqu'a 0.01e-3kg/kg!
     3771        ! Pour les isotopes, ca donne des x1+dx negatifs.
     3772        ! Ce n'est pas physique mais il faut quand meme s'adapter.
     3773        ! Pour cela, on considere que d'abord on fait rentrer le flux de masse
    37753774        ! descendant, et ensuite seulement on fait sortir le flux de masse
    37763775        ! sortant.
    … …  
    37783777        ! isotopique de la vapeur d'eau q1.
    37793778        ! 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
     3779        ! On verifie que quand k est petit, on tend vers la formulation
    37813780        ! 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
     3781        ! Comme on est habitues a la formulation habituelle, qu'elle a fait ses
     3782        ! preuves, on la garde sauf dans le cas ou dq/q<-0.9 ou on utilise la
    37843783        ! nouvelle formulation.
    37853784        ! 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
     3785        ! Meme avec cette nouvelle foirmulation, on a encore des isotopes
     3786        ! negatifs, cette fois a cause des ddfts
     3787        ! On considere donc les tendances et serie et non en parallele quand on
    37893788        ! calcule R_tmp.
    37903789        dq_tmp=0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)*delt ! utile ci-dessous
    37913790        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
     3791                ! nouvelle formulation ou on fait d'abord entrer k*q2 et ensuite
    37933792                ! seulement on fait sortir k*q1 sans changement de composition
    37943793                ! isotopique
    … …  
    38283827           enddo ! do ixt = 1, ntraciso
    38293828        else !if (dq_tmp/rr(il,1).lt.-0.9) then
    3830                 ! formulation habituelle qui avait toujours marché de 2006 à
    3831                 ! décembre 2017.
     3829                ! formulation habituelle qui avait toujours marche de 2006 a
     3830                ! decembre 2017.
    38323831           do ixt = 1, ntraciso     
    38333832                fxt(ixt,il,1)=fxt(ixt,il,1) &
    … …  
    42324231        ! ad.
    42334232#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.
     4233       ! ici, on separe 2 cas, pour eviter le cas pathologique decrit plus haut
     4234       ! pour la tendance liee a Am en i=1, qui peut conduire a des isotopes
     4235       ! negatifs dans les cas ou les flux de masse soustrait plus de 90% de la
     4236       ! vapeur de la couche. Voir plus haut le detail des equations.
     4237       ! La difference ici est qu'on considere les flux de masse amp1 et ad en
     4238       ! meme temps.
    42404239       dq_tmp= 0.01*grav*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i)) &
    42414240    &            -ad(il)*(rr(il,i)-rr(il,i-1)))*delt
    4242        ! c'est équivalent à dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi
     4241       ! c'est equivalent a dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi
    42434242       if ((dq_tmp/rr(il,i).lt.-0.9).and.correction_excess_aberrant) then
    42444243        ! nouvelle formulation
    … …  
    44304429        ! on change le traitement de cette ligne le 8 mai 2009:
    44314430        ! 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
     4431        ! c'est a dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
     4432        ! si Relij!=Rclw, alors un fractionnement isotopique non physique etait
    44344433        ! 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.
     4434        ! En fait, awat represente le surplus de condensat dans le melange par
     4435        ! rapport a celui restant dans la colonne adiabatique
     4436        ! ce surplus a la meme compo que le elij, sans fractionnement.
     4437        ! d'ou le nouveau traitement ci-dessous.
    44394438      if (elij(il,k,i).gt.0.0) then
    44404439        do ixt = 1, ntraciso
    44414440          xtawat(ixt)=awat*(xtelij(ixt,il,k,i)/elij(il,k,i))
    4442 !          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas nécessaire
     4441!          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
    44434442        enddo
    44444443      else !if (elij(il,k,i).gt.0.0) then
    44454444          ! normalement, si elij(il,k,i)<=0, alors awat=0
    4446           ! on le vérifie. Si c'est vrai -> xtawat=0 aussi
     4445          ! on le verifie. Si c'est vrai -> xtawat=0 aussi
    44474446#ifdef ISOVERIF
    44484447        call iso_verif_egalite(awat,0.0,'cv30_yield 3779')
    … …  
    49424941     &       'cv30_yield 5029,O18, evap')
    49434942          if ((il.eq.1636).and.(i.eq.9)) then
    4944             write(*,*) 'cv30_yield 5057: ici, on vérifie deltaD_nobx'
     4943            write(*,*) 'cv30_yield 5057: ici, on verifie deltaD_nobx'
    49454944            write(*,*) 'il,i=',il,i
    49464945            write(*,*) 'fr(il,i),bx,fr(il,i)-bx=',fr(il,i),bx,fr(il,i)-bx
    … …  
    49734972        else ! taggage des ddfts:
    49744973        ! 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.
     4974        ! cas pour le water tagging puisqu'il y a conversion des molecules
     4975        ! blances entrainees en molecule rouges.
    49774976        ! Il faut donc prendre en compte ce taux de conversion quand
    49784977        ! entrainement d'env vers ddft
    … …  
    49834982!     :           -conversion(iiso)   
    49844983
    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).
     4984        ! Pb: quand on discretise, dqp/dt n'est pas verifee numeriquement.
     4985        ! on se retrouve donc avec des d Ye/dt differents de 0 meme si ye=0 ( on
     4986        ! note X les molecules poubelles et Y les molecules ddfts).
    49884987
    49894988        ! Solution alternative: Dans le cas entrainant, Ye ne varie que par
    49904989        ! 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
     4990        ! calcule donc ce terme directement avec schema amont:
     4991
     4992        ! ajout deja de l'evap
    49944993        do ixt = 1+niso,ntraciso
    49954994             fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    50035002          do iiso = 1, niso
    50045003             
    5005              ixt_ddft=index_trac(izone_ddft,iiso) 
     5004             ixt_ddft=itZonIso(izone_ddft,iiso) 
    50065005             if (mp(il,i).gt.mp(il,i+1)) then
    50075006                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    … …  
    50165015     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    50175016       
    5018              ixt_poubelle=index_trac(izone_poubelle,iiso)
     5017             ixt_poubelle=itZonIso(izone_poubelle,iiso)
    50195018             fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso)
    50205019             fxt(ixt_poubelle,il,i)=fxt(ixt_poubelle,il,i) &
    … …  
    50335032     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    50345033
    5035                 ixt_ddft=index_trac(izone_ddft,iiso)
     5034                ixt_ddft=itZonIso(izone_ddft,iiso)
    50365035                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    50375036     &           *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
    50385037                fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso) 
    50395038
    5040                ixt_revap=index_trac(izone_revap,iiso) 
     5039               ixt_revap=itZonIso(izone_revap,iiso) 
    50415040               fxt_revap(iiso)=0.01*grav*dpinv*(mp(il,i+1)* &
    50425041     &                  (xtp(ixt_revap,il,i+1)-xt(ixt_revap,il,i)) &
    … …  
    50495048     &                   -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
    50505049                if (Xe(iiso).gt.ridicule) then
    5051                   do izone=1,ntraceurs_zone
     5050                  do izone=1,nzone
    50525051                   if ((izone.ne.izone_revap).and. &
    50535052     &                   (izone.ne.izone_ddft)) then
    5054                     ixt=index_trac(izone,iiso)
     5053                    ixt=itZonIso(izone,iiso)
    50555054                    fxt(ixt,il,i)=fxt(ixt,il,i) &
    50565055     &                   +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso)
    50575056                   endif !if ((izone.ne.izone_revap).and.
    5058                   enddo !do izone=1,ntraceurs_zone   
     5057                  enddo !do izone=1,nzone   
    50595058#ifdef ISOVERIF
    50605059!                write(*,*) 'iiso=',iiso
    … …  
    50695068#endif
    50705069                else !if (abs(dXe).gt.ridicule) then
    5071                     ! dans ce cas, fxtXe doit être faible
     5070                    ! dans ce cas, fxtXe doit etre faible
    50725071                   
    50735072#ifdef ISOVERIF
    … …  
    50785077                endif
    50795078#endif                   
    5080                 do izone=1,ntraceurs_zone
     5079                do izone=1,nzone
    50815080                   if ((izone.ne.izone_revap).and. &
    50825081     &                   (izone.ne.izone_ddft)) then                   
    5083                     ixt=index_trac(izone,iiso)
     5082                    ixt=itZonIso(izone,iiso)
    50845083                    if (izone.eq.izone_poubelle) then
    50855084                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    50865085                    else !if (izone.eq.izone_poubelle) then
    5087                         ! pas de tendance pour ce tag là
     5086                        ! pas de tendance pour ce tag la
    50885087                    endif !if (izone.eq.izone_poubelle) then
    50895088                   endif !if ((izone.ne.izone_revap).and.
    5090                 enddo !do izone=1,ntraceurs_zone
     5089                enddo !do izone=1,nzone
    50915090#ifdef ISOVERIF
    50925091                  call iso_verif_traceur_justmass(fxt(1,il,i), &
    … …  
    50995098               
    51005099            else !if (mp(il,i).gt.mp(il,i+1)) then
    5101                 ! cas détrainant: pas de problèmes
     5100                ! cas detrainant: pas de problemes
    51025101                do ixt=1+niso,ntraciso
    51035102                fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    52375236        enddo !do ixt = 1+niso,ntraciso
    52385237!        write(*,*) 'tmp cv3_yield 4165: i,il=',i,il
    5239 !        ixt_poubelle=index_trac(izone_poubelle,iso_eau)
    5240 !        ixt_ddft=index_trac(izone_ddft,iso_eau)
     5238!        ixt_poubelle=itZonIso(izone_poubelle,iso_eau)
     5239!        ixt_ddft=itZonIso(izone_ddft,iso_eau)
    52415240!        write(*,*) 'delt*fxt(ixt_poubelle,il,i)=',
    52425241!     :           delt*fxt(ixt_poubelle,il,i)
    … …  
    52445243!        write(*,*) 'xt(iso_eau,il,i)=',xt(iso_eau,il,i)
    52455244          do iiso = 1, niso
    5246              ixt_poubelle=index_trac(izone_poubelle,iiso)
    5247              ixt_ddft=index_trac(izone_ddft,iiso) 
     5245             ixt_poubelle=itZonIso(izone_poubelle,iiso)
     5246             ixt_ddft=itZonIso(izone_ddft,iiso) 
    52485247             if (mp(il,i).gt.mp(il,i+1)) then
    52495248                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    … …  
    53895388  DO il = 1, ncum
    53905389
    5391 ! attention, on corrige un problème C Risi
     5390! attention, on corrige un probleme C Risi
    53925391      IF (cvflag_grav) then
    53935392
    … …  
    57225721!             write(*,*) 'cv30_routine 3990: fin des il pour i=',i
    57235722          enddo !do i=1,nl
    5724 !          write(*,*) 'cv30_routine 3990: fin des vérifs sur homogen'
     5723!          write(*,*) 'cv30_routine 3990: fin des verifs sur homogen'
    57255724#endif
    57265725
    … …  
    60276026
    60286027  ! 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
     6028  ! et eau condensee precipitee dans masse d'air sature : l_m*dM_m/dzdz.dzdz
    60306029  DO j = 1, nam1
    60316030    DO k = 1, j - 1
    … …  
    61116110
    61126111#ifdef ISO
    6113     use infotrac_phy, ONLY: ntraciso
     6112    use infotrac_phy, ONLY: ntraciso=>ntiso
    61146113#ifdef ISOVERIF
    61156114    use isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &
    … …  
    62266225
    62276226#ifdef ISOVERIF
    6228         write(*,*) 'cv30_routines 4293: entrée dans cv3_uncompress'
     6227        write(*,*) 'cv30_routines 4293: entree dans cv3_uncompress'
    62296228#endif
    62306229  DO i = 1, ncum
    … …  
    63466345
    63476346        ! 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.
     6347        ! Il faut donc recalculer ep, et hp qui a deja ete calcule et
     6348        ! qui en depend
     6349        ! Toutes les autres variables fn de ep sont calculees plus bas.
    63516350
    63526351#include "cvthermo.h"

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv3_enthalpmix.F90

    r4004 r4368  
    77                       )
    88#ifdef ISO
    9     use infotrac_phy, ONLY: ntraciso
     9    use infotrac_phy, ONLY: ntiso
    1010#endif
    1111  ! **************************************************************
    … …  
    4343  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
    4444#ifdef ISO
    45   REAL, DIMENSION (ntraciso,len,nd), INTENT (IN)     :: xt
     45  REAL, DIMENSION (ntiso,len,nd), INTENT (IN)     :: xt
    4646#endif
    4747!input/output:
    … …  
    5454  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
    5555#ifdef ISO
    56   REAL, DIMENSION (ntraciso,len), INTENT (OUT)     :: xtmix
     56  REAL, DIMENSION (ntiso,len), INTENT (OUT)     :: xtmix
    5757#endif
    5858!internal variables :
    … …  
    153153        vmix(i) = vmix(i) + v(i, j)*wi(i, j)
    154154#ifdef ISO
    155         do ixt=1,ntraciso
     155        do ixt=1,ntiso
    156156          xtmix(ixt,i) = xtmix(ixt,i) +  xt(ixt,i, j)*wi(i, j)
    157157        enddo

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv3_estatmix.F90

    r4004 r4368  
    77                       )
    88#ifdef ISO
    9     use infotrac_phy, ONLY: ntraciso
     9    use infotrac_phy, ONLY: ntiso
    1010#endif
    1111  ! **************************************************************
    … …  
    4646  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
    4747#ifdef ISO
    48   REAL, DIMENSION (ntraciso,len,nd), INTENT (IN)     :: xt
     48  REAL, DIMENSION (ntiso,len,nd), INTENT (IN)     :: xt
    4949#endif
    5050!input/output:
    … …  
    5757  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
    5858#ifdef ISO
    59   REAL, DIMENSION (ntraciso,len), INTENT (OUT)     :: xtmix
     59  REAL, DIMENSION (ntiso,len), INTENT (OUT)     :: xtmix
    6060#endif
    6161!internal variables :
    … …  
    153153        vmix(i) = vmix(i) +  v(i, j)*wi(i, j)
    154154#ifdef ISO
    155         do ixt=1,ntraciso
     155        do ixt=1,ntiso
    156156          xtmix(ixt,i) = xtmix(ixt,i) +  xt(ixt,i, j)*wi(i, j)
    157157        enddo

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv3_routines.F90

    r4004 r4368  
    314314     &   )
    315315#ifdef ISO
    316     use infotrac_phy, ONLY: ntraciso
     316    use infotrac_phy, ONLY: ntraciso=>ntiso
    317317#ifdef ISOVERIF
    318318    use isotopes_verif_mod, ONLY: iso_verif_positif,iso_verif_noNaN,iso_verif_egalite
    … …  
    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
    … …  
    685685     &                   )
    686686#ifdef ISO
    687 USE infotrac_phy, ONLY: ntraciso
     687USE infotrac_phy, ONLY: ntraciso=>ntiso
    688688USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
    689689        iso_eau,iso_HDO,ridicule
    … …  
    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
    … …  
    12741274  USE print_control_mod, ONLY: lunout
    12751275#ifdef ISO
    1276     use infotrac_phy, ONLY: ntraciso
     1276    use infotrac_phy, ONLY: ntraciso=>ntiso
    12771277    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
    12781278#ifdef ISOVERIF
    … …  
    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
    … …  
    14741474  USE print_control_mod, ONLY: prt_level
    14751475#ifdef ISO
    1476 use infotrac_phy, ONLY: ntraciso
     1476use infotrac_phy, ONLY: ntraciso=>ntiso
    14771477USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
    14781478        iso_eau,iso_HDO
    … …  
    21232123#endif 
    21242124#ifdef ISOVERIF
    2125         write(*,*) 'cv3_routine 1259: avant condiso'
     2125        !write(*,*) 'cv3_routine 1259: avant condiso'
    21262126        do i=1,ncum
    21272127           if (iso_HDO.gt.0) then           
    … …  
    27772777
    27782778#ifdef ISO
    2779 use infotrac_phy, ONLY: ntraciso,niso,index_trac
     2779use infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
    27802780USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, &
    27812781        ridicule
    … …  
    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
    … …  
    35803580        call iso_verif_traceur(xtclw(1,il,im), &
    35813581     &          'condiso_liq_ice_vectiso_trac 358')
    3582         if (iso_verif_positif_nostop(xtclw(index_trac( &
     3582        if (iso_verif_positif_nostop(xtclw(itZonIso( &
    35833583     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    35843584     &           ,'cv3_routines 909').eq.1) then
    … …  
    35883588     &             niso,ntraciso,index_zone,izone_cond     
    35893589               stop
    3590          endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     3590         endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    35913591#endif             
    35923592         enddo !do il = 1, ncum   
    … …  
    36153615  USE print_control_mod, ONLY: prt_level, lunout
    36163616#ifdef ISO
    3617     use infotrac_phy, ONLY: ntraciso
     3617    use infotrac_phy, ONLY: ntraciso=>ntiso
    36183618    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO, &
    36193619        ridicule
    … …  
    36283628#ifdef ISOTRAC
    36293629    use isotrac_mod, only: option_cond,izone_cond
    3630     use infotrac_phy, ONLY: index_trac
     3630    use infotrac_phy, ONLY: itZonIso
    36313631#ifdef ISOVERIF
    36323632    use isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
    … …  
    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( &
    3995      &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
     3995     &          xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
    39963996     &          -xtwdtrain(iso_eau,il), &
    39973997     &          'cv3_routines 2795').eq.1) then
    … …  
    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
    … …  
    45354535!        if (option_tmin.ge.1) then
    45364536!           call iso_verif_positif(xtwater(
    4537 !     :           index_trac(izone_cond,iso_eau),il,i+1)
     4537!     :           itZonIso(izone_cond,iso_eau),il,i+1)
    45384538!     :           -xtwater(iso_eau,il,i+1),
    45394539!     :          'cv3_routines 3083')
    … …  
    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, &
    … …  
    46024602!        if (option_tmin.ge.1) then
    46034603!         call iso_verif_positif(xtwater(
    4604 !     :           index_trac(izone_cond,iso_eau),il,i)
     4604!     :           itZonIso(izone_cond,iso_eau),il,i)
    46054605!     :           -xtwater(iso_eau,il,i),
    46064606!     :          'cv3_routines 3143')
    … …  
    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
    … …  
    47414741
    47424742#ifdef ISO
    4743     use infotrac_phy, ONLY: ntraciso,niso, &
    4744 &       ntraceurs_zone,index_trac
    4745     use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO
     4743    use infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
     4744    use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
    47464745#ifdef ISOVERIF
    47474746    use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
    4748         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
     4747        iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant,iso_verif_O18_aberrant, &
    47494748        iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
    47504749        iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
    4751         iso_verif_positif
     4750        iso_verif_positif,iso_verif_O18_aberrant_nostop,deltaO
    47524751#endif
    47534752#ifdef ISOTRAC
    … …  
    48644863      real xtbx(ntraciso), xtawat(ntraciso,nloc)
    48654864      ! cam debug
    4866       ! pour l'homogénéisation sous le nuage:
     4865      ! pour l'homogeneisation sous le nuage:
    48674866      real bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
    48684867#ifdef DIAGISO
    4869         ! diagnostiques juste: tendance des différents processus
     4868        ! diagnostiques juste: tendance des differents processus
    48704869      real fxt_detrainement(niso,nloc,nd)
    48714870      real fxt_fluxmasse(niso,nloc,nd)
    … …  
    49174916#ifdef ISO
    49184917       ! cam debug
    4919 !       write(*,*) 'cv3_routines 3082: entrée dans cv3_yield'
     4918!       write(*,*) 'cv3_routines 3082: entree dans cv3_yield'
    49204919       ! en cam debug
    49214920       do ixt = 1, ntraciso
    … …  
    49944993  END DO
    49954994#ifdef ISO
    4996 ! on initialise mieux fr et fxt par securité
     4995! on initialise mieux fr et fxt par securite
    49974996  fr(:,:)=0.0
    49984997  fxt(:,:,:)=0.0
    … …  
    52935292           call iso_verif_aberrant((xt(iso_HDO,il,1) &
    52945293     &        +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), &
    5295      &           'cv3_yield 3125, ddft en 1')
     5294     &           'cv3_yield 3125, ddft en 1')               
     5295          endif !if (iso_HDO.gt.0) then
     5296          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
     5297     &           (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
     5298           call iso_verif_O18_aberrant((xt(iso_HDO,il,1) &
     5299     &        +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)),(xt(iso_O18,il,1) &
     5300     &        +delt*fxt(iso_O18,il,1))/(rr(il,1)+delt*fr(il,1)), &
     5301     &        'cv3_yield 3125b, ddft en 1')               
    52965302          endif !if (iso_HDO.gt.0) then
    52975303#ifdef ISOTRAC
    … …  
    53865392     &         +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), &
    53875393     &         'cv3_yield 3127, dtr melanges')
     5394          endif !if (iso_HDO.gt.0) then
     5395          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
     5396     &           (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
     5397           call iso_verif_O18_aberrant((xt(iso_HDO,il,1) &
     5398     &        +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)),(xt(iso_O18,il,1) &
     5399     &        +delt*fxt(iso_O18,il,1))/(rr(il,1)+delt*fr(il,1)), &
     5400     &        'cv3_yield 3127b, dtr melanges')               
    53885401          endif !if (iso_HDO.gt.0) then
    53895402#ifdef ISOTRAC
    … …  
    58455858        else ! taggage des ddfts:
    58465859        ! 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.
     5860        ! cas pour le water tagging puisqu'il y a conversion des molecules
     5861        ! blances entrainees en molecule rouges.
    58495862        ! Il faut donc prendre en compte ce taux de conversion quand
    58505863        ! entrainement d'env vers ddft
    … …  
    58555868!     :           -conversion(iiso)   
    58565869
    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).
     5870        ! Pb: quand on discretise, dqp/dt n'est pas verifee numeriquement.
     5871        ! on se retrouve donc avec des d Ye/dt differents de 0 meme si ye=0 ( on
     5872        ! note X les molecules poubelles et Y les molecules ddfts).
    58605873
    58615874        ! Solution alternative: Dans le cas entrainant, Ye ne varie que par
    58625875        ! 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
     5876        ! calcule donc ce terme directement avec schema amont:
     5877
     5878        ! ajout deja de l'evap
    58665879        do ixt = 1+niso,ntraciso
    58675880             fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    58755888          do iiso = 1, niso
    58765889             
    5877              ixt_ddft=index_trac(izone_ddft,iiso) 
     5890             ixt_ddft=itZonIso(izone_ddft,iiso) 
    58785891             if (mp(il,i).gt.mp(il,i+1)) then
    58795892                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    … …  
    58885901     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    58895902       
    5890              ixt_poubelle=index_trac(izone_poubelle,iiso)
     5903             ixt_poubelle=itZonIso(izone_poubelle,iiso)
    58915904             fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso)
    58925905             fxt(ixt_poubelle,il,i)=fxt(ixt_poubelle,il,i) &
    … …  
    59055918     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    59065919
    5907                 ixt_ddft=index_trac(izone_ddft,iiso)
     5920                ixt_ddft=itZonIso(izone_ddft,iiso)
    59085921                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    59095922     &           *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
    59105923                fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso) 
    59115924
    5912                ixt_revap=index_trac(izone_revap,iiso) 
     5925               ixt_revap=itZonIso(izone_revap,iiso) 
    59135926               fxt_revap(iiso)=0.01*grav*dpinv*(mp(il,i+1)* &
    59145927     &                  (xtp(ixt_revap,il,i+1)-xt(ixt_revap,il,i)) &
    … …  
    59215934     &                   -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
    59225935                if (Xe(iiso).gt.ridicule) then
    5923                   do izone=1,ntraceurs_zone
     5936                  do izone=1,nzone
    59245937                   if ((izone.ne.izone_revap).and. &
    59255938     &                   (izone.ne.izone_ddft)) then
    5926                     ixt=index_trac(izone,iiso)
     5939                    ixt=itZonIso(izone,iiso)
    59275940                    fxt(ixt,il,i)=fxt(ixt,il,i) &
    59285941     &                   +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso)
    59295942                   endif !if ((izone.ne.izone_revap).and.
    5930                   enddo !do izone=1,ntraceurs_zone   
     5943                  enddo !do izone=1,nzone   
    59315944#ifdef ISOVERIF
    59325945!                write(*,*) 'iiso=',iiso
    … …  
    59415954#endif
    59425955                else !if (abs(dXe).gt.ridicule) then
    5943                     ! dans ce cas, fxtXe doit être faible
     5956                    ! dans ce cas, fxtXe doit etre faible
    59445957                   
    59455958#ifdef ISOVERIF
    … …  
    59505963                endif
    59515964#endif                   
    5952                 do izone=1,ntraceurs_zone
     5965                do izone=1,nzone
    59535966                   if ((izone.ne.izone_revap).and. &
    59545967     &                   (izone.ne.izone_ddft)) then                   
    5955                     ixt=index_trac(izone,iiso)
     5968                    ixt=itZonIso(izone,iiso)
    59565969                    if (izone.eq.izone_poubelle) then
    59575970                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    59585971                    else !if (izone.eq.izone_poubelle) then
    5959                         ! pas de tendance pour ce tag là
     5972                        ! pas de tendance pour ce tag la
    59605973                    endif !if (izone.eq.izone_poubelle) then
    59615974                   endif !if ((izone.ne.izone_revap).and.
    5962                 enddo !do izone=1,ntraceurs_zone
     5975                enddo !do izone=1,nzone
    59635976#ifdef ISOVERIF
    59645977                  call iso_verif_traceur_justmass(fxt(1,il,i), &
    … …  
    59715984               
    59725985            else !if (mp(il,i).gt.mp(il,i+1)) then
    5973                 ! cas détrainant: pas de problèmes
     5986                ! cas detrainant: pas de problemes
    59745987                do ixt=1+niso,ntraciso
    59755988                fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    60076020     &           fxt(iso_HDO,il,i)/fr(il,i), &
    60086021     &           'cv3_yield 3662').eq.1) then
    6009                 write(*,*) 'il,i,icb(il),inb(il)=',il,i,icb(il),inb(il)
    6010                 write(*,*) 'fr(il,i),delt=',fr(il,i),delt
     6022!                write(*,*) 'il,i,icb(il),inb(il)=',il,i,icb(il),inb(il)
     6023!                write(*,*) 'fr(il,i),delt=',fr(il,i),delt
    60116024#ifdef DIAGISO
    60126025                if (fq_ddft(il,i).ne.0.0) then
    … …  
    61116124     &           /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3384, flux masse')
    61126125        endif !if (iso_HDO.gt.0) then
     6126        if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
     6127     &           (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
     6128           call iso_verif_O18_aberrant((xt(iso_HDO,il,i) &
     6129     &        +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) &
     6130     &        +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
     6131     &        'cv3_yield 3384b, flux masse')               
     6132          endif !if (iso_HDO.gt.0) then
    61136133#ifdef ISOTRAC
    61146134        call iso_verif_traceur_justmass(fxt(1,il,1),'cv3_routine 3626')
    … …  
    61766196        ! on change le traitement de cette ligne le 8 mai 2009:
    61776197        ! 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
     6198        ! c'est a dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
     6199        ! si Relij!=Rclw, alors un fractionnement isotopique non physique etait
    61806200        ! 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.
     6201        ! En fait, awat represente le surplus de condensat dans le melange par
     6202        ! rapport a celui restant dans la colonne adiabatique
     6203        ! ce surplus a la meme compo que le elij, sans fractionnement.
     6204        ! d'ou le nouveau traitement ci-dessous.
    61856205      if (elij(il,k,i).gt.0.0) then
    61866206        do ixt = 1, ntraciso
    61876207          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
     6208!          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
    61896209        enddo !do ixt = 1, ntraciso
    61906210      else !if (elij(il,k,i).gt.0.0) then
    61916211          ! normalement, si elij(il,k,i)<=0, alors awat=0
    6192           ! on le vérifie. Si c'est vrai -> xtawat=0 aussi
     6212          ! on le verifie. Si c'est vrai -> xtawat=0 aussi
    61936213#ifdef ISOVERIF
    61946214        call iso_verif_egalite(awat(il),0.0,'cv3_yield 3779')
    … …  
    63446364       do ixt = 1, ntraciso
    63456365        fxt(ixt,il,i)=fxt(ixt,il,i) &
    6346      &   +0.1*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
     6366     &   +0.01*grav*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
    63476367       enddo
    63486368
    63496369#ifdef DIAGISO
    63506370       fq_detrainement(il,i)=fq_detrainement(il,i) &
    6351               +0.1*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
     6371              +0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
    63526372       f_detrainement(il,i)=f_detrainement(il,i) &
    6353               +0.1*dpinv*ment(il,k,i)
     6373              +0.01*grav*dpinv*ment(il,k,i)
    63546374       q_detrainement(il,i)=q_detrainement(il,i) &
    6355               +0.1*dpinv*ment(il,k,i)*qent(il,k,i)
     6375              +0.01*grav*dpinv*ment(il,k,i)*qent(il,k,i)
    63566376       do ixt = 1, niso
    63576377        fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
    6358      &          +0.1*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
     6378     &          +0.01*grav*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
    63596379        xt_detrainement(ixt,il,i)=xt_detrainement(ixt,il,i) &
    6360      &          +0.1*dpinv*ment(il,k,i)*xtent(ixt,il,k,i)
     6380     &          +0.01*grav*dpinv*ment(il,k,i)*xtent(ixt,il,k,i)
    63616381       enddo
    63626382#endif     
    … …  
    63876407     &           /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3605b, dtr mels')
    63886408          endif !if (iso_HDO.gt.0) then       
     6409          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
     6410     &           (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
     6411           call iso_verif_O18_aberrant((xt(iso_HDO,il,i) &
     6412     &        +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) &
     6413     &        +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
     6414     &        'cv3_yield 6415c, dtr mels')               
     6415          endif !if (iso_HDO.gt.0) then
    63896416#ifdef ISOTRAC
    63906417        call iso_verif_traceur_justmass(fxt(1,il,i),'cv3_routine 3972')
    … …  
    65536580
    65546581#ifdef ISOVERIF
     6582        do i=inb(il)-1,inb(il)
    65556583        if (iso_eau.gt.0) then
    6556               call iso_verif_egalite(fxt(iso_eau,il,inb(il)-1), &
    6557      &           fr(il,inb(il)-1),'cv3_routines 5308')
     6584              call iso_verif_egalite(fxt(iso_eau,il,i), &
     6585     &           fr(il,i),'cv3_routines 5308')
    65586586        endif !if (iso_eau.gt.0) then
    65596587        if ((iso_HDO.gt.0).and. &
    6560      &           (rr(il,inb(il)-1)+delt*fr(il,inb(il)-1).gt.ridicule)) then
    6561            call iso_verif_aberrant((xt(iso_HDO,il,inb(il)-1) &
    6562      &           +delt*fxt(iso_HDO,il,inb(il)-1)) &
    6563      &           /(rr(il,inb(il)-1)+delt*fr(il,inb(il)-1)),'cv3_yield 6555')
    6564         endif !if (iso_HDO.gt.0) then   
     6588     &           (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
     6589           call iso_verif_aberrant((xt(iso_HDO,il,i) &
     6590     &           +delt*fxt(iso_HDO,il,i)) &
     6591     &           /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6555')
     6592        endif !if (iso_HDO.gt.0) then                 
     6593          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
     6594     &           (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
     6595           if (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) &
     6596     &        +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) &
     6597     &        +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
     6598     &        'cv3_yield 6555b').eq.1) then
     6599                write(*,*) 'il,i=',il,i
     6600                write(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
     6601                write(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) &
     6602     &                  +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)))
     6603                write(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i)
     6604                write(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i))
     6605                write(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i)
     6606                write(*,*) 'qent(il,inb(il),inb(il)),rr(il,inb(il))=', &
     6607     &                   qent(il,inb(il),inb(il)),rr(il,inb(il))
     6608                write(*,*) 'xtent(il,inb(il),inb(il)),xt(il,inb(il))=', &
     6609     &                   xtent(iso_O18,il,inb(il),inb(il)),xt(iso_O18,il,inb(il))
     6610                write(*,*) 'deltaOent=',deltaO(xtent(iso_O18,il,inb(il),inb(il))/qent(il,inb(il),inb(il)))
     6611                write(*,*) 'bx,xtbx(iso_O18)=',bx,xtbx(iso_O18)
     6612                stop
     6613
     6614           endif               
     6615         endif !if (iso_HDO.gt.0) then
     6616        enddo
    65656617#endif       
    65666618#endif
    … …  
    67526804     &           +delt*fxt(iso_HDO,il,i)) &
    67536805     &           /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6744')
    6754         endif !if (iso_HDO.gt.0) then   
     6806        endif !if (iso_HDO.gt.0) then               
     6807          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
     6808     &           (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
     6809           call iso_verif_O18_aberrant((xt(iso_HDO,il,i) &
     6810     &        +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) &
     6811     &        +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
     6812     &        'cv3_yield 6744b')               
     6813          endif !if (iso_HDO.gt.0) then 
    67556814#endif         
    67566815#endif
    … …  
    68006859      print *,' CV3_YIELD : alpha_qpos ',alpha_qpos(1)
    68016860    ENDIF
     6861
    68026862!
    68036863  DO il = 1, ncum
    … …  
    68416901           call iso_verif_aberrant((xt(iso_HDO,il,i) &
    68426902     &           +delt*fxt(iso_HDO,il,i)) &
    6843      &           /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6835')
    6844         endif !if (iso_HDO.gt.0) then   
     6903     &           /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6835a')
     6904        endif !if (iso_HDO.gt.0) then       
     6905          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
     6906     &           (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
     6907           if (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) &
     6908     &        +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) &
     6909     &        +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
     6910     &        'cv3_yield 6835b').eq.1) then
     6911                write(*,*) 'il,i=',il,i
     6912                write(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
     6913                write(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) &
     6914     &                  +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)))
     6915                write(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i)
     6916                write(*,*) 'alpha_qpos=',alpha_qpos(il)
     6917                write(*,*) 'fq*delt avantqpos=',delt*fr(il,i)*alpha_qpos(il)
     6918                write(*,*) 'deltaO avantqpos=',deltaO((xt(iso_O18,il,i) &
     6919     &                  +delt*fxt(iso_O18,il,i)*alpha_qpos(il))/(rr(il,i)+delt*fr(il,i)*alpha_qpos(il)))
     6920                write(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i))
     6921                write(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i)
     6922                stop
     6923           endif               
     6924          endif !if (iso_HDO.gt.0) then
    68456925#endif   
    68466926#ifdef DIAGISO
    … …  
    68506930        fq_detrainement(il, i) = fq_detrainement(il, i)/alpha_qpos(il)
    68516931        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)
     6932          fxt_ddft(ixt,il, i) = fxt_ddft(ixt,il, i)/alpha_qpos(il)
     6933          fxt_evapprecip(ixt,il, i) = fxt_evapprecip(ixt,il, i)/alpha_qpos(il)
     6934          fxt_fluxmasse(ixt,il, i) = fxt_fluxmasse(ixt,il, i)/alpha_qpos(il)
     6935          fxt_detrainement(ixt,il, i) = fxt_detrainement(ixt,il, i)/alpha_qpos(il)
    68566936        enddo ! do ixt=1,ntraciso
    68576937#endif       
    … …  
    71797259    ENDDO       ! k
    71807260
    7181 ! 14/01/15 AJ delta n'a rien à faire là...                                                 
     7261! 14/01/15 AJ delta n'a rien a faire la...                                                 
    71827262    DO il = 1, ncum                                                  ! cld
    71837263!!      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) &                         ! cld
    … …  
    71957275
    71967276! IM cf. FH
    7197 ! 14/01/15 AJ ne correspond pas à ce qui a été codé par JYG et SB           
     7277! 14/01/15 AJ ne correspond pas a ce qui a ete code par JYG et SB           
    71987278                                                         
    71997279      IF (iflag_clw==0) THEN                                         ! cld
    … …  
    72907370
    72917371! 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
     7372! et eau condensee precipitee dans masse d'air sature : l_m*dM_m/dzdz.dzdz
    72937373  DO j = 1, nl
    72947374    DO k = 1, nl
    … …  
    73787458     &     )   
    73797459#ifdef ISO
    7380     use infotrac_phy, ONLY: ntraciso
     7460    use infotrac_phy, ONLY: ntraciso=>ntiso
    73817461#ifdef ISOVERIF
    73827462    use isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &
    … …  
    75767656
    75777657        ! 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.
     7658        ! Il faut donc recalculer ep, et hp qui a deja ete calcule et
     7659        ! qui en depend
     7660        ! Toutes les autres variables fn de ep sont calculees plus bas.
    75817661
    75827662  include "cvthermo.h"
    … …  
    76137693
    76147694        ! 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
     7695        ! connait pas ep, on ne connait pas les melanges, ddfts etc... qui sont
    76167696        ! necessaires au calcul de la cape dans la nouvelle physique
    76177697       

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv3a_compress.F90

    r4004 r4368  
    3434  ! **************************************************************
    3535#ifdef ISO
    36     use infotrac_phy, ONLY: ntraciso
     36    use infotrac_phy, ONLY: ntraciso=>ntiso
    3737    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
    3838#ifdef ISOVERIF

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv3a_uncompress.F90

    r4004 r4368  
    5454
    5555#ifdef ISO
    56   USE infotrac_phy, ONLY : ntraciso
     56  USE infotrac_phy, ONLY : ntraciso=>ntiso
    5757#endif
    5858  IMPLICIT NONE

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv3p_mixing.F90

    r4004 r4368  
    2121  USE add_phys_tend_mod, ONLY: fl_cor_ebil
    2222#ifdef ISO
    23   USE infotrac_phy, ONLY: ntraciso
     23  USE infotrac_phy, ONLY: ntraciso=>ntiso
    2424  USE isotopes_mod, ONLY: pxtmelt,pxtice
    2525  USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
    … …  
    12901290#ifdef ISO
    12911291#ifdef ISOVERIF
    1292        write(*,*) 'cv3p_mixing 2540: ', &
    1293         'verif finale en sortant de cv3p_mixing'
    1294        write(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
     1292!       write(*,*) 'cv3p_mixing 2540: ', &
     1293!        'verif finale en sortant de cv3p_mixing'
     1294!       write(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
    12951295       do im = 1, nd
    12961296       do jm = 1, nd
    … …  
    13011301            call iso_verif_egalite_choix(xtent(iso_eau,il,im,jm), &
    13021302              qent(il,im,jm),'cv3p_mixing 2112',errmax,errmaxrel)
    1303           endif !if (use_iso_eau) then
     1303          endif !if (iso_eau>0) then
    13041304#ifdef ISOTRAC
    13051305        call iso_verif_traceur_justmass(xtelij(1,il,im,jm), &   
    … …  
    13531353!        call iso_verif_traceur(xtclw(1,il,im), &
    13541354!               'cv3p_mixing 358')
    1355 !        if (iso_verif_positif_nostop(xtclw(index_trac( &
     1355!        if (iso_verif_positif_nostop(xtclw(itZonIso( &
    13561356!                izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    13571357!                ,'cv3p_mixing 909').eq.1) then
    … …  
    13611361!                  niso,ntraciso,index_zone,izone_cond     
    13621362!               stop
    1363 !         endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     1363!         endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    13641364!#endif             
    13651365!         enddo !do il = 1, ncum   

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv_driver.F90

    r4004 r4368  
    2525  USE dimphy
    2626#ifdef ISO
    27   USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
     27  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso,nzone
    2828  USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
    2929#ifdef ISOVERIF
    … …  
    511511    CALL cv_param(nd)
    512512#ifdef ISO
    513        write(*,*) 'cv_driver 454: isos pas prévus ici'
     513       write(*,*) 'cv_driver 454: isos pas prevus ici'
    514514       stop
    515515#endif
    … …  
    687687!c--debug
    688688#ifdef ISOVERIF
    689        write(*,*) 'cv_driver 621: après cv3_undilute1'
     689       write(*,*) 'cv_driver 621: apres cv3_undilute1'
    690690       do k = 1, klev
    691691        do i = 1, klon
    … …  
    752752        !write(*,*) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
    753753        !write(*,*) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1)
    754         !write(*,*) 'iso_eau,use_iso=',iso_eau,use_iso
    755754       do k = 1, klev
    756755        do i = 1, nloc
    … …  
    783782#ifdef ISO
    784783#ifdef ISOVERIF
    785        write(*,*) 'cv_driver 720: après cv3_compress'           
     784       write(*,*) 'cv_driver 720: apres cv3_compress'           
    786785       do k = 1, klev
    787786        do i = 1, ncum
    … …  
    883882                ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
    884883                ,epmax_diag)
    885         ! on écrase ep et recalcule hp
     884        ! on écrase ep et recalcule hp
    886885    END IF
    887886
    … …  
    910909#ifdef ISO
    911910#ifdef ISOVERIF
    912        write(*,*) 'cv_driver 837: après cv3_mixing'
     911       write(*,*) 'cv_driver 837: apres cv3_mixing'
    913912       do k = 1, klev
    914913       do j = 1, klev
    … …  
    925924           call iso_verif_traceur_justmass(xtelij(1,i,j,k), &
    926925     &           'cv_driver 847')
    927            ! on ne vérfier pas le deltaD ici car peut dépasser le seuil
    928            ! raisonable pour températures très froides.
     926           ! on ne verifie pas le deltaD ici car peut depasser le seuil
     927           ! raisonable pour temperatures tres froides.
    929928#endif               
    930929        enddo
    … …  
    940939           call iso_verif_traceur(xt(1,i,k),'cv_driver 856')
    941940           if (option_tmin.eq.1) then
    942              if (iso_verif_positif_nostop(xtclw(index_trac( &
     941             if (iso_verif_positif_nostop(xtclw(itZonIso( &
    943942     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    944943     &           ,'cv_driver 909').eq.1) then
    … …  
    946945               write(*,*) 'xtclw=',xtclw(:,i,k)
    947946               stop
    948              endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     947             endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    949948           endif !if ((option_traceurs.eq.17).or.
    950949#endif 
    … …  
    1000999       write(*,*) 'klev=',klev
    10011000#ifdef ISOVERIF
    1002        write(*,*) 'cv_driver 930: après cv3_unsat'
     1001       write(*,*) 'cv_driver 930: apres cv3_unsat'
    10031002       do k = 1, klev
    10041003        do i = 1, ncum
    … …  
    10481047            do i = 1, ncum
    10491048               do iiso=1,niso
    1050                   ixt_ddft=index_trac(izone_ddft,iiso)
    1051                   ixt_poubelle=index_trac(izone_poubelle,iiso)
     1049                  ixt_ddft=itZonIso(izone_ddft,iiso)
     1050                  ixt_poubelle=itZonIso(izone_poubelle,iiso)
    10521051                  xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
    10531052     &                    +xtp(ixt_poubelle,i,k)
    … …  
    10631062          do k = 1, klev
    10641063            do i = 1, ncum
    1065                do izone=1,ntraceurs_zone
     1064               do izone=1,nzone
    10661065                 if (izone.eq.izone_ddft) then
    10671066                   do iiso=1,niso
    1068                      ixt_ddft=index_trac(izone,iiso)
    1069                      ixt_revap=index_trac(izone_revap,iiso)
     1067                     ixt_ddft=itZonIso(izone,iiso)
     1068                     ixt_revap=itZonIso(izone_revap,iiso)
    10701069                     xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
    10711070                   enddo !do iiso=1,niso
    10721071                 elseif (izone.eq.izone_ddft) then
    1073                     ! rien à faire
     1072                    ! rien a faire
    10741073                 else !if (izone.eq.izone_ddft) then
    10751074                   do iiso=1,niso
    1076                      ixt=index_trac(izone,iiso)
     1075                     ixt=itZonIso(izone,iiso)
    10771076                     xtp(ixt,i,k)=0.0
    10781077                   enddo !do iiso=1,niso
    10791078                 endif !if (izone.eq.izone_ddft) then
    1080                enddo !do izone=1,ntraceurs_zone
     1079               enddo !do izone=1,nzone
    10811080#ifdef ISOVERIF
    10821081               call iso_verif_traceur(xtp(1,i,k),'cv_driver 1059')
    … …  
    12471246! si icvflag_Tpa=0, alors la fraction de glace dans l'ascendance adiabatique est
    12481247  ! fonction de la temperature de l'environnement et la temperature de l'ascendance est
    1249   ! calculee en deux itérations, une en supposant qu'il n'y a pas de glace et l'autre
    1250   ! en ajoutant la glace (ancien schéma d'Arnaud Jam).
     1248  ! calculee en deux iterations, une en supposant qu'il n'y a pas de glace et l'autre
     1249  ! en ajoutant la glace (ancien schema d'Arnaud Jam).
    12511250! si icvflag_Tpa=1, alors la fraction de glace dans l'ascendance adiabatique est
    12521251  ! fonction de la temperature de l'environnement et la temperature de l'ascendance est

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/cva_driver.F90

    r4004 r4368  
    5454  USE add_phys_tend_mod, ONLY: fl_cor_ebil
    5555#ifdef ISO
    56   USE infotrac_phy, ONLY: ntraciso,niso,niso,index_trac,ntraceurs_zone
    57   USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
     56  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,niso,itZonIso,nzone
     57  USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,ridicule,bidouille_anti_divergence
    5858#ifdef ISOVERIF
    5959    use isotopes_verif_mod
    … …  
    963963#ifdef ISO
    964964#ifdef ISOVERIF
    965        write(*,*) 'cva_driver 621: après cv3_undilute1'
     965       write(*,*) 'cva_driver 621: apres cv3_undilute1'
    966966       do k=1,nd
    967967        do i = 1, len
    … …  
    11211121#ifdef ISO
    11221122#ifdef ISOVERIF
    1123        write(*,*) 'cva_driver 720: après cv3_compress'
    1124        write(*,*) 'len, nloc, ncum,nd=',len, nloc, ncum,nd
     1123       write(*,*) 'cva_driver 720: apres cv3_compress'
     1124!       write(*,*) 'len, nloc, ncum,nd=',len, nloc, ncum,nd
    11251125       do k=1,nd
    11261126        do i = 1, ncum
    … …  
    11491149         call iso_verif_positif(qnk(i),'cva_driver 966b') 
    11501150       enddo !do i = 1, ncum
    1151        write(*,*) 'cva_driver 1142: après cv3_compress OK'
     1151!       write(*,*) 'cva_driver 1142: apres cv3_compress OK'
    11521152#endif
    11531153#endif
    … …  
    13571357#ifdef ISO
    13581358#ifdef ISOVERIF
    1359        write(*,*) 'cva_driver 837: après cv3_mixing'
    1360        write(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
     1359       write(*,*) 'cva_driver 837: apres cv3_mixing'
     1360!       write(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
    13611361       do k=1,nd
    13621362       do j = 1, nd
    … …  
    13881388           call iso_verif_traceur(xt(1,i,k),'cva_driver 856')
    13891389           if (option_tmin.eq.1) then
    1390              if (iso_verif_positif_nostop(xtclw(index_trac( &
     1390             if (iso_verif_positif_nostop(xtclw(itZonIso( &
    13911391     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    13921392     &           ,'cva_driver 909').eq.1) then
    … …  
    13941394               write(*,*) 'xtclw=',xtclw(:,i,k)
    13951395               stop
    1396              endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     1396             endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    13971397           endif !if ((option_traceurs.eq.17).or.
    13981398#endif 
    … …  
    15091509            do i = 1, ncum
    15101510               do iiso=1,niso
    1511                   ixt_ddft=index_trac(izone_ddft,iiso)
    1512                   ixt_poubelle=index_trac(izone_poubelle,iiso)
     1511                  ixt_ddft=itZonIso(izone_ddft,iiso)
     1512                  ixt_poubelle=itZonIso(izone_poubelle,iiso)
    15131513                  xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
    15141514     &                    +xtp(ixt_poubelle,i,k)
    … …  
    15241524          do k=1,nd
    15251525            do i = 1, ncum
    1526                do izone=1,ntraceurs_zone
     1526               do izone=1,nzone
    15271527                 if (izone.eq.izone_ddft) then
    15281528                   do iiso=1,niso
    1529                      ixt_ddft=index_trac(izone,iiso)
    1530                      ixt_revap=index_trac(izone_revap,iiso)
     1529                     ixt_ddft=itZonIso(izone,iiso)
     1530                     ixt_revap=itZonIso(izone_revap,iiso)
    15311531                     xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
    15321532                   enddo !do iiso=1,niso
    … …  
    15351535                 else !if (izone.eq.izone_ddft) then
    15361536                   do iiso=1,niso
    1537                      ixt=index_trac(izone,iiso)
     1537                     ixt=itZonIso(izone,iiso)
    15381538                     xtp(ixt,i,k)=0.0
    15391539                   enddo !do iiso=1,niso
    15401540                 endif !if (izone.eq.izone_ddft) then
    1541                enddo !do izone=1,ntraceurs_zone
     1541               enddo !do izone=1,nzone
    15421542#ifdef ISOVERIF
    15431543               call iso_verif_traceur(xtp(1,i,k),'cva_driver 1059')
    … …  
    15971597            call iso_verif_aberrant( &
    15981598     &          (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
    1599      &          /(q(i,k)+delt*fq(i,k)),'cva_driver 855')
     1599     &          /(q(i,k)+delt*fq(i,k)),'cva_driver 855a')
     1600                if (iso_O18.gt.0) then
     1601            call iso_verif_O18_aberrant( &
     1602     &          (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
     1603     &          /(q(i,k)+delt*fq(i,k)), &
     1604     &          (xt(iso_O18,i,k)+delt*fxt(iso_O18,i,k)) &
     1605     &          /(q(i,k)+delt*fq(i,k)),'cva_driver 855b')
     1606                endif
    16001607          endif
    16011608         endif

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/fisrtilp.F90

    r3927 r4368  
    2727  USE add_phys_tend_mod, only : fl_cor_ebil
    2828#ifdef ISO
    29   USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
     29  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
    3030  USE isotopes_mod
    3131!, ONLY: essai_convergence,bidouille_anti_divergence, &
    … …  
    15101510                   zxtn(iso_eau,i)=zqn(i)
    15111511#ifdef ISOTRAC
    1512                    zxtn(index_trac(izone_poubelle,iso_eau),i)=zqn(i) 
     1512                   zxtn(itZonIso(izone_poubelle,iso_eau),i)=zqn(i) 
    15131513                   if (option_tmin.eq.1) then                   
    15141514                     zxtcs(iso_eau,i)=zqcs(i)
    … …  
    18481848           ! part le tag résuel et le condensat
    18491849           if (iso_verif_positif_choix_nostop( &
    1850      &           zxt_ancien(index_trac(izone,iso_eau),i) &
    1851      &          -zxt(index_trac(izone,iso_eau),i),1e-8,'ilp 1270') &
     1850     &           zxt_ancien(itZonIso(izone,iso_eau),i) &
     1851     &          -zxt(itZonIso(izone,iso_eau),i),1e-8,'ilp 1270') &
    18521852     &          .eq.1) then
    18531853            write(*,*) 'i,izone,rneb=',i,izone,rneb(i,k)

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/fonte_neige_mod.F90

    r3940 r4368  
    345345    snow_evap = 0.
    346346 
    347 #ifdef ISOVERIF
    348         write(*,*) 'klon,snow_evap(413)=',klon,snow_evap(413)
    349 #endif
    350347
    351348    IF (.NOT. ok_lic_cond) THEN
    … …  
    358355         snow = MAX(0.0, snow)                   !---just in case
    359356      END WHERE
    360 #ifdef ISOVERIF
    361         write(*,*) 'fonte_neige 342: snow_evap(413)=',snow_evap(413)
    362 #endif
    363357
    364358    ELSE
    … …  
    367361      snow = snow - snow_evap * dtime         !---snow that remains or deposits on the ground
    368362      snow = MAX(0.0, snow)                   !---just in case
    369 #ifdef ISOVERIF
    370         write(*,*) 'fonte_neige 351: snow_evap(413)=',snow_evap(413)
    371         write(*,*) 'evap(413)=',evap(413)
    372         write(*,*) 'snow(413),dtime=',snow(413),dtime
    373 #endif
    374363
    375364   ENDIF
    … …  
    380369        snow_evap_diag(:)=snow_evap(:)
    381370        coeff_rel_diag=coeff_rel
    382 #ifdef ISOVERIF
    383         write(*,*) 'fonte neige 350: snow_evap_diag(1)=',snow_evap_diag(1)
    384         write(*,*) 'klon,snow_evap_diag(413)=',klon,snow_evap_diag(413)
    385         write(*,*) 'snow_evap(413)=',snow_evap(413)
    386 #endif
    387371#endif
    388372
    … …  
    645629        ! de dépendance circulaire.
    646630
    647     USE infotrac_phy, ONLY: ntraciso,niso
     631    USE infotrac_phy, ONLY: ntiso,niso
    648632    USE isotopes_mod, ONLY: iso_eau   
    649633  USE indice_sol_mod   
    … …  
    655639         ! inputs
    656640        integer klon,knon
    657         real xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
     641        real xtprecip_snow(ntiso,klon),xtprecip_rain(ntiso,klon)
    658642    INTEGER, INTENT(IN)                  :: nisurf
    659643    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
    … …  
    681665      IF (nisurf == is_lic) THEN
    682666!         coeff_rel = dtime/(tau_calv * rday)
    683 #ifdef ISOVERIF
    684         j=61
    685         write(*,*) 'fonte_neige 636:'
    686         write(*,*) 'run_off_lic_0(j)=',run_off_lic_0(j)
    687         write(*,*) 'xtrun_off_lic_0(:,j)=',xtrun_off_lic_0(:,j)
    688 #endif
     667
    689668         DO i = 1, knon
    690669          j = knindex(i)

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/isotopes_mod.F90

    r3927 r4368  
    33
    44MODULE isotopes_mod
    5 USE infotrac_phy, ONLY: ntraciso,niso,indnum_fn_num,ok_isotrac,use_iso, &
    6 &       niso_possibles
    7 IMPLICIT NONE
    8 SAVE
    9 
    10 ! contient toutes les variables isotopiques et leur initialisation
    11 ! les routines specifiquement isotopiques sont dans
    12 ! isotopes_routines_mod pour éviter dépendance circulaire avec
    13 ! isotopes_verif_mod.
    14 
    15 
    16 ! indices des isotopes
    17 integer, save :: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO ! indices de 1 à niso: les isos n'existant pas sont mis à 0
    18 !$OMP THREADPRIVATE(iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO)
    19 
    20 integer :: iso_eau_possible,iso_HDO_possible,iso_O18_possible,iso_O17_possible,iso_HTO_possible ! indices de 1 à niso_possibles: ils correspondent aux tableaux définis dans infotrac:
    21 ! tnom_iso=(/'eau','HDO','O18','O17','HTO'/)
    22 ! ce sont ces indices qui doivent être utilisés avec use_iso, puisque use_iso est défini comme DIMENSION(niso_possibles)
    23 parameter (iso_eau_possible=1)
    24 parameter (iso_HDO_possible=2)
    25 parameter (iso_O18_possible=3)
    26 parameter (iso_O17_possible=4)
    27 parameter (iso_HTO_possible=5)
    28 
    29 integer, save :: ntracisoOR
     5   USE strings_mod,  ONLY: msg, real2str, int2str, bool2str, maxlen, strIdx, strStack
     6   USE infotrac_phy, ONLY: isoName
     7   IMPLICIT NONE
     8   INTERFACE get_in; MODULE PROCEDURE getinp_s, getinp_i, getinp_r, getinp_l;  END INTERFACE get_in
     9   SAVE
     10
     11  !--- Contains all isotopic variables + their initialization
     12  !--- Isotopes-specific routines are in isotopes_routines_mod to avoid circular dependencies with isotopes_verif_mod.
     13
     14   !--- Isotopes indices (in [1,niso] ; non-existing => 0 index)
     15   INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO
     16!$OMP THREADPRIVATE(iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO)
     17
     18   INTEGER, SAVE :: ntracisoOR
    3019!$OMP THREADPRIVATE(ntracisoOR)
    3120
    32 ! variables indépendantes des isotopes
    33 
    34 real, save :: pxtmelt,pxtice,pxtmin,pxtmax
    35 !$OMP THREADPRIVATE(pxtmelt,pxtice,pxtmin,pxtmax)
    36 real, save ::  tdifexp, tv0cin, thumxt1
     21   !--- Variables not depending on isotopes
     22   REAL,    SAVE :: pxtmelt, pxtice, pxtmin, pxtmax
     23!$OMP THREADPRIVATE(pxtmelt, pxtice, pxtmin, pxtmax)
     24   REAL,    SAVE :: tdifexp, tv0cin, thumxt1
    3725!$OMP THREADPRIVATE(tdifexp, tv0cin, thumxt1)
    38 integer, save :: ntot
     26   INTEGER, SAVE :: ntot
    3927!$OMP THREADPRIVATE(ntot)
    40 real, save :: h_land_ice
     28   REAL,    SAVE :: h_land_ice
    4129!$OMP THREADPRIVATE(h_land_ice)
    42 real, save :: P_veg
     30   REAL,    SAVE :: P_veg
    4331!$OMP THREADPRIVATE(P_veg)
    44 real, save ::  musi,lambda_sursat
    45 !$OMP THREADPRIVATE(lambda_sursat)
    46 real, save :: Kd
     32   REAL,    SAVE :: musi, lambda_sursat
     33!$OMP THREADPRIVATE(musi, lambda_sursat)
     34   REAL,    SAVE :: Kd
    4735!$OMP THREADPRIVATE(Kd)
    48 real, save ::  rh_cste_surf_cond,T_cste_surf_cond
    49 !$OMP THREADPRIVATE(rh_cste_surf_cond,T_cste_surf_cond)
    50 
    51 logical, save ::   bidouille_anti_divergence
    52                 ! si true, rappel régulier de xteau vers q, pour éviter dérives lentes
     36   REAL,    SAVE :: rh_cste_surf_cond, T_cste_surf_cond
     37!$OMP THREADPRIVATE(rh_cste_surf_cond, T_cste_surf_cond)
     38   LOGICAL, SAVE :: bidouille_anti_divergence    ! T: regularly, xteau <- q to avoid slow drifts
    5339!$OMP THREADPRIVATE(bidouille_anti_divergence)
    54 logical, save ::   essai_convergence
    55                 ! si false, on fait rigoureusement comme dans LMDZ sans isotopes,
    56                 ! meme si c'est génant pour les isotopes
     40   LOGICAL, SAVE :: essai_convergence            ! F: as in LMDZ without isotopes (bad for isotopes)
    5741!$OMP THREADPRIVATE(essai_convergence)
    58 integer, save ::   initialisation_iso
    59                 ! 0: dans fichier
    60                 ! 1: R=0
    61                 ! 2: R selon distill rayleigh
    62                 ! 3: R=Rsmow
     42   INTEGER, SAVE :: initialisation_iso           ! 0: file ; 1: R=0 ; 2: R=distill. Rayleigh ; 3: R=Rsmow
    6343!$OMP THREADPRIVATE(initialisation_iso)
    64 integer, save ::  modif_SST ! 0 par defaut, 1 si on veut modifier la sst
    65                 ! 2 et 3: profils de SST
     44   INTEGER, SAVE :: modif_SST                    ! 0: default ; 1: modified SST ; 2, 3: SST profiles
    6645!$OMP THREADPRIVATE(modif_SST)
    67 real, save ::  deltaTtest ! modif de la SST, uniforme.
     46   REAL,    SAVE :: deltaTtest                   ! Uniform modification of the SST
    6847!$OMP THREADPRIVATE(deltaTtest)
    69 integer, save ::  modif_sic ! on met des trous dans glace de mer
     48   INTEGER, SAVE :: modif_sic                    ! Holes in the Sea Ice
    7049!$OMP THREADPRIVATE(modif_sic)
    71 real, save ::  deltasic ! fraction de trous minimale
     50   REAL,    SAVE :: deltasic                     ! Minimal holes fraction
    7251!$OMP THREADPRIVATE(deltasic)
    73 real, save :: deltaTtestpoles
     52   REAL,    SAVE :: deltaTtestpoles
    7453!$OMP THREADPRIVATE(deltaTtestpoles)
    75 real, save ::  sstlatcrit
    76 !$OMP THREADPRIVATE(sstlatcrit)
    77 real, save ::  dsstlatcrit
    78 !$OMP THREADPRIVATE(dsstlatcrit)
    79 real, save ::  deltaO18_oce
     54   REAL,    SAVE :: sstlatcrit, dsstlatcrit
     55!$OMP THREADPRIVATE(sstlatcrit, dsstlatcrit)
     56   REAL,    SAVE :: deltaO18_oce
    8057!$OMP THREADPRIVATE(deltaO18_oce)
    81 integer, save ::  albedo_prescrit ! 0 par defaut
    82                         ! 1 si on veut garder albedo constant
     58   INTEGER, SAVE :: albedo_prescrit              ! 0: default ; 1: constant albedo
    8359!$OMP THREADPRIVATE(albedo_prescrit)
    84 real, save ::  lon_min_albedo,lon_max_albedo
    85 !$OMP THREADPRIVATE(lon_min_albedo,lon_max_albedo)
    86 real, save :: lat_min_albedo,lat_max_albedo
    87 !$OMP THREADPRIVATE(lat_min_albedo,lat_max_albedo)
    88 real, save ::  deltaP_BL,tdifexp_sol
     60   REAL,    SAVE :: lon_min_albedo, lon_max_albedo, lat_min_albedo, lat_max_albedo
     61!$OMP THREADPRIVATE(lon_min_albedo, lon_max_albedo, lat_min_albedo, lat_max_albedo)
     62   REAL,    SAVE :: deltaP_BL,tdifexp_sol
    8963!$OMP THREADPRIVATE(deltaP_BL,tdifexp_sol)
    90 integer, save ::  ruissellement_pluie,alphak_stewart
    91 !$OMP THREADPRIVATE(ruissellement_pluie,alphak_stewart)
    92 integer, save :: calendrier_guide
     64   INTEGER, SAVE :: ruissellement_pluie, alphak_stewart
     65!$OMP THREADPRIVATE(ruissellement_pluie, alphak_stewart)
     66   INTEGER, SAVE :: calendrier_guide
    9367!$OMP THREADPRIVATE(calendrier_guide)
    94 integer, save :: cste_surf_cond
     68   INTEGER, SAVE :: cste_surf_cond
    9569!$OMP THREADPRIVATE(cste_surf_cond)
    96 real, save :: mixlen
     70   REAL,    SAVE :: mixlen
    9771!$OMP THREADPRIVATE(mixlen)
    98 integer, save :: evap_cont_cste
     72   INTEGER, SAVE :: evap_cont_cste
    9973!$OMP THREADPRIVATE(evap_cont_cste)
    100 real, save ::  deltaO18_evap_cont,d_evap_cont
    101 !$OMP THREADPRIVATE(deltaO18_evap_cont,d_evap_cont)
    102 integer, save ::  nudge_qsol,region_nudge_qsol
    103 !$OMP THREADPRIVATE(nudge_qsol,region_nudge_qsol)
    104 integer, save :: nlevmaxO17
     74   REAL,    SAVE :: deltaO18_evap_cont, d_evap_cont
     75!$OMP THREADPRIVATE(deltaO18_evap_cont, d_evap_cont)
     76   INTEGER, SAVE :: nudge_qsol, region_nudge_qsol
     77!$OMP THREADPRIVATE(nudge_qsol, region_nudge_qsol)
     78   INTEGER, SAVE :: nlevmaxO17
    10579!$OMP THREADPRIVATE(nlevmaxO17)
    106 integer, save ::  no_pce
    107 !       real, save :: slope_limiterxy,slope_limiterz
     80   INTEGER, SAVE :: no_pce
    10881!$OMP THREADPRIVATE(no_pce)
    109 real, save :: A_satlim
     82   REAL,    SAVE :: A_satlim
    11083!$OMP THREADPRIVATE(A_satlim)
    111 integer, save ::  ok_restrict_A_satlim,modif_ratqs
    112 !$OMP THREADPRIVATE(ok_restrict_A_satlim,modif_ratqs)
    113 real, save ::  Pcrit_ratqs,ratqsbasnew
    114 !$OMP THREADPRIVATE(Pcrit_ratqs,ratqsbasnew)
    115 real, save :: fac_modif_evaoce
     84   INTEGER, SAVE :: ok_restrict_A_satlim, modif_ratqs
     85!$OMP THREADPRIVATE(ok_restrict_A_satlim, modif_ratqs)
     86   REAL,    SAVE :: Pcrit_ratqs, ratqsbasnew
     87!$OMP THREADPRIVATE(Pcrit_ratqs, ratqsbasnew)
     88   REAL,    SAVE :: fac_modif_evaoce
    11689!$OMP THREADPRIVATE(fac_modif_evaoce)
    117 integer, save :: ok_bidouille_wake
     90   INTEGER, SAVE :: ok_bidouille_wake
    11891!$OMP THREADPRIVATE(ok_bidouille_wake)
    119 logical :: cond_temp_env
     92   LOGICAL, SAVE :: cond_temp_env
    12093!$OMP THREADPRIVATE(cond_temp_env)
    12194
    122 
    123 ! variables tableaux fn de niso
    124 real, ALLOCATABLE, DIMENSION(:), save :: tnat, toce, tcorr
    125 !$OMP THREADPRIVATE(tnat, toce, tcorr)
    126 real, ALLOCATABLE, DIMENSION(:), save :: tdifrel
    127 !$OMP THREADPRIVATE(tdifrel)
    128 real, ALLOCATABLE, DIMENSION(:), save :: talph1, talph2, talph3
    129 !$OMP THREADPRIVATE(talph1, talph2, talph3)
    130 real, ALLOCATABLE, DIMENSION(:), save :: talps1, talps2
    131 !$OMP THREADPRIVATE(talps1, talps2)
    132 real, ALLOCATABLE, DIMENSION(:), save :: tkcin0, tkcin1, tkcin2
     95   !--- Vectors of length "niso"
     96   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     97                    tnat, toce, tcorr, tdifrel
     98!$OMP THREADPRIVATE(tnat, toce, tcorr, tdifrel)
     99   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     100                    talph1, talph2, talph3, talps1, talps2
     101!$OMP THREADPRIVATE(talph1, talph2, talph3, talps1, talps2)
     102   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     103                    tkcin0, tkcin1, tkcin2
    133104!$OMP THREADPRIVATE(tkcin0, tkcin1, tkcin2)
    134 real, ALLOCATABLE, DIMENSION(:), save :: alpha_liq_sol
    135 !$OMP THREADPRIVATE(alpha_liq_sol)
    136 real, ALLOCATABLE, DIMENSION(:), save :: Rdefault, Rmethox
    137 !$OMP THREADPRIVATE(Rdefault, Rmethox)
    138 character*3, ALLOCATABLE, DIMENSION(:), save :: striso
    139 !$OMP THREADPRIVATE(striso)
    140 real, save :: fac_coeff_eq17_liq, fac_coeff_eq17_ice
     105   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     106                    alpha_liq_sol, Rdefault, Rmethox
     107!$OMP THREADPRIVATE(alpha_liq_sol, Rdefault, Rmethox)
     108   REAL, SAVE ::    fac_coeff_eq17_liq, fac_coeff_eq17_ice
    141109!$OMP THREADPRIVATE(fac_coeff_eq17_liq, fac_coeff_eq17_ice)
    142110
    143       real ridicule ! valeur maximale pour qu'une variable de type
    144                     ! rapoport de mélange puisse être considérée comme négligeable. Si
    145                     ! négligeable, alors on ne verifie pas si sa compo iso esta bérrante.
    146       parameter (ridicule=1e-12)     
    147 !      parameter (ridicule=1)
    148 !
    149       real ridicule_rain ! valeur limite de ridicule pour les flux de pluies (rain, zrfl...)
    150       parameter (ridicule_rain=1e-8) ! en kg/s <-> 1e-3mm/day
    151 
    152       real ridicule_evap ! valeur limite de ridicule pour les evap
    153       parameter (ridicule_evap=ridicule_rain*1e-2) ! en kg/s <-> 1e-3mm/day
    154 
    155       real ridicule_qsol ! valeur limite de ridicule pour les qsol
    156       parameter (ridicule_qsol=ridicule_rain) ! en kg <-> 1e-8kg
    157 
    158       real ridicule_snow ! valeur limite de ridicule pour les snow
    159       parameter (ridicule_snow=ridicule_qsol) ! en kg/s <-> 1e-8kg
    160      
    161         real expb_max
    162         parameter (expb_max=30.0)
    163 
    164         ! spécifique au tritium:
    165        
    166 
    167 logical, save :: ok_prod_nucl_tritium ! si oui, production de tritium par essais nucleaires
     111   !--- Negligible lower thresholds: no need to check for absurd values under these lower limits
     112   REAL, PARAMETER :: &
     113      ridicule      = 1e-12,              & ! For mixing ratios
     114      ridicule_rain = 1e-8,               & ! For rain fluxes (rain, zrfl...) in kg/s <-> 1e-3 mm/day
     115      ridicule_evap = ridicule_rain*1e-2, & ! For evaporations                in kg/s <-> 1e-3 mm/day
     116      ridicule_qsol = ridicule_rain,      & ! For qsol                        in kg <-> 1e-8 kg
     117      ridicule_snow = ridicule_qsol         ! For snow                        in kg <-> 1e-8 kg
     118   REAL, PARAMETER :: expb_max = 30.0
     119
     120   !--- Specific to HTO:
     121   LOGICAL, SAVE :: ok_prod_nucl_tritium    !--- TRUE => HTO production by nuclear tests
    168122!$OMP THREADPRIVATE(ok_prod_nucl_tritium)
    169         integer nessai
    170         parameter (nessai=486)
    171         integer, save :: day_nucl(nessai)
    172 !$OMP THREADPRIVATE(day_nucl)
    173         integer, save :: month_nucl(nessai)
    174 !$OMP THREADPRIVATE(month_nucl)
    175         integer, save :: year_nucl(nessai)
    176 !$OMP THREADPRIVATE(year_nucl)
    177         real, save :: lat_nucl(nessai)
    178 !$OMP THREADPRIVATE(lat_nucl)
    179         real, save :: lon_nucl(nessai)
    180 !$OMP THREADPRIVATE(lon_nucl)
    181         real, save :: zmin_nucl(nessai)
    182 !$OMP THREADPRIVATE(zmin_nucl)
    183         real, save :: zmax_nucl(nessai)
    184 !$OMP THREADPRIVATE(zmax_nucl)
    185         real, save :: HTO_nucl(nessai)
    186 !$OMP THREADPRIVATE(HTO_nucl)
    187 
     123   INTEGER, PARAMETER :: nessai = 486
     124   INTEGER, DIMENSION(nessai), SAVE :: &
     125                    day_nucl, month_nucl, year_nucl
     126!$OMP THREADPRIVATE(day_nucl, month_nucl, year_nucl)
     127   REAL,    DIMENSION(nessai), SAVE :: &
     128                    lat_nucl, lon_nucl, zmin_nucl, zmax_nucl, HTO_nucl
     129!$OMP THREADPRIVATE(lat_nucl, lon_nucl, zmin_nucl, zmax_nucl, HTO_nucl)
     130 
    188131 
    189132CONTAINS
    190133
    191   SUBROUTINE iso_init()
    192       use ioipsl_getin_p_mod, ONLY : getin_p
    193       implicit none
    194 
    195 ! -- local variables:
    196 
    197       integer ixt
    198       ! référence O18
    199       real fac_enrichoce18
    200       real alpha_liq_sol_O18, &
    201      &     talph1_O18,talph2_O18,talph3_O18, &
    202      &     talps1_O18,talps2_O18, &
    203      &     tkcin0_O18,tkcin1_O18,tkcin2_O18, &
    204      &     tdifrel_O18 
     134SUBROUTINE iso_init()
     135   USE infotrac_phy,       ONLY: ntiso, niso, getKey
     136    USE strings_mod,       ONLY: maxlen
     137   IMPLICIT NONE
     138
     139   !=== Local variables:
     140   INTEGER :: ixt
     141
     142   !--- H2[18]O reference
     143   REAL :: fac_enrichoce18, alpha_liq_sol_O18, &
     144           talph1_O18, talph2_O18, talph3_O18, talps1_O18, talps2_O18, &
     145           tkcin0_O18, tkcin1_O18, tkcin2_O18, tdifrel_O18 
     146
     147   !--- For H2[17]O
     148   REAL    :: fac_kcin, pente_MWL
    205149     
    206       ! cas de l'O17
    207       real fac_kcin
    208       real pente_MWL
    209       integer ierr
    210      
    211       logical ok_nocinsat, ok_nocinsfc !sensi test
    212       parameter (ok_nocinsfc=.FALSE.)  ! if T: no kinetic effect in sfc evap
    213       parameter (ok_nocinsat=.FALSE.)  ! if T: no sursaturation effect for ice
    214       logical Rdefault_smow
    215       parameter (Rdefault_smow=.FALSE.) ! si T: Rdefault=smow; si F: nul
    216       ! pour le tritium
    217       integer iessai
    218 
    219     write(*,*) 'iso_init 219: entree'
    220 
    221 ! allocations mémoire
    222 allocate (tnat(niso))
    223 allocate (toce(niso))
    224 allocate (tcorr(niso))
    225 allocate (tdifrel(niso))
    226 allocate (talph1(niso))
    227 allocate (talph2(niso))
    228 allocate (talph3(niso))
    229 allocate (talps1(niso))
    230 allocate (talps2(niso))
    231 allocate (tkcin0(niso))
    232 allocate (tkcin1(niso))
    233 allocate (tkcin2(niso))
    234 allocate (alpha_liq_sol(niso))
    235 allocate (Rdefault(niso))
    236 allocate (Rmethox(niso))
    237 allocate (striso(niso))
    238 
    239 
    240 !--------------------------------------------------------------
    241 ! General:
    242 !--------------------------------------------------------------
    243 
    244 ! -- verif du nombre d'isotopes:
    245       write(*,*) 'iso_init 64: niso=',niso
    246 
    247 ! init de ntracisoOR: on écrasera en cas de ok_isotrac si complications avec
    248 ! ORCHIDEE
    249       ntracisoOR=ntraciso 
    250              
    251 ! -- Type of water isotopes:
    252 
    253         iso_eau=indnum_fn_num(1)
    254         iso_HDO=indnum_fn_num(2)
    255         iso_O18=indnum_fn_num(3)
    256         iso_O17=indnum_fn_num(4)
    257         iso_HTO=indnum_fn_num(5)
    258         write(*,*) 'iso_init 59: iso_eau=',iso_eau
    259         write(*,*) 'iso_HDO=',iso_HDO
    260         write(*,*) 'iso_O18=',iso_O18
    261         write(*,*) 'iso_O17=',iso_O17
    262         write(*,*) 'iso_HTO=',iso_HTO
    263         write(*,*) 'iso_init 251: use_iso=',use_iso
    264 
    265       ! initialisation
    266         lambda_sursat=0.004
    267         thumxt1=0.75*1.2
    268         ntot=20
    269         h_land_ice=20. ! à comparer aux 3000mm de snow_max
    270         P_veg=1.0
    271         bidouille_anti_divergence=.false.
    272         essai_convergence=.false.
    273         initialisation_iso=0
    274         modif_sst=0
    275         modif_sic=0
    276         deltaTtest=0.0
    277         deltasic=0.1
    278         deltaTtestpoles=0.0
    279         sstlatcrit=30.0
    280         deltaO18_oce=0.0
    281         albedo_prescrit=0
    282         lon_min_albedo=-200
    283         lon_max_albedo=200
    284         lat_min_albedo=-100
    285         lat_max_albedo=100
    286         deltaP_BL=10.0
    287         ruissellement_pluie=0
    288         alphak_stewart=1
    289         tdifexp_sol=0.67
    290         calendrier_guide=0
    291         cste_surf_cond=0
    292 mixlen=35.0       
    293 evap_cont_cste=0.0
    294 deltaO18_evap_cont=0.0
    295 d_evap_cont=0.0
    296 nudge_qsol=0
    297 region_nudge_qsol=1
    298 nlevmaxO17=50
    299 no_pce=0
    300 A_satlim=1.0
    301 ok_restrict_A_satlim=0
    302 !        slope_limiterxy=2.0
    303 !        slope_limiterz=2.0
    304 modif_ratqs=0
    305 Pcrit_ratqs=500.0
    306 ratqsbasnew=0.05
    307 
    308 fac_modif_evaoce=1.0
    309 ok_bidouille_wake=0
    310 cond_temp_env=.false.
    311 ! si oui, la temperature de cond est celle de l'environnement,
    312 ! pour eviter bugs quand temperature dans ascendances convs est
    313 ! mal calculee
    314 ok_prod_nucl_tritium=.false.
    315 
    316 ! lecture des paramètres isotopiques:
    317 ! pour que ça marche en openMP, il faut utiliser getin_p. Car le getin ne peut
    318 ! être appelé que par un thread à la fois, et ça pose tout un tas de problème,
    319 ! d'où tout un tas de magouilles comme dans conf_phys_m. A terme, tout le monde
    320 ! lira par getin_p.
    321 call getin_p('lambda',lambda_sursat)
    322 call getin_p('thumxt1',thumxt1)
    323 call getin_p('ntot',ntot)
    324 call getin_p('h_land_ice',h_land_ice)
    325 call getin_p('P_veg',P_veg)
    326 call getin_p('bidouille_anti_divergence',bidouille_anti_divergence)
    327 call getin_p('essai_convergence',essai_convergence)
    328 call getin_p('initialisation_iso',initialisation_iso)
    329 !if (ok_isotrac) then     
    330 !if (initialisation_iso.eq.0) then
    331 !  call getin_p('initialisation_isotrac',initialisation_isotrac)
    332 !endif !if (initialisation_iso.eq.0) then
    333 !endif !if (ok_isotrac) then     
    334 call getin_p('modif_sst',modif_sst)
    335 if (modif_sst.ge.1) then
    336 call getin_p('deltaTtest',deltaTtest)
    337 if (modif_sst.ge.2) then
    338   call getin_p('deltaTtestpoles',deltaTtestpoles)
    339   call getin_p('sstlatcrit',sstlatcrit)
     150   !--- Sensitivity tests
     151   LOGICAL, PARAMETER ::   ok_nocinsfc = .FALSE. ! if T: no kinetic effect in sfc evap
     152   LOGICAL, PARAMETER ::   ok_nocinsat = .FALSE. ! if T: no sursaturation effect for ice
     153   LOGICAL, PARAMETER :: Rdefault_smow = .FALSE. ! if T: Rdefault=smow; if F: nul
     154
     155   !--- For [3]H
     156   INTEGER :: iessai
     157
     158   CHARACTER(LEN=maxlen) :: modname, sxt
     159   REAL, ALLOCATABLE :: tmp(:)
     160
     161   modname = 'iso_init'
     162   CALL msg('219: entree', modname)
     163
     164   !--------------------------------------------------------------
     165   ! General:
     166   !--------------------------------------------------------------
     167
     168   !--- Check number of isotopes
     169   CALL msg('64: niso = '//TRIM(int2str(niso)), modname)
     170
     171   !--- Init de ntracisoOR: on ecrasera en cas de traceurs de tagging isotopiques
     172   !                     (nzone>0) si complications avec ORCHIDEE
     173   ntracisoOR = ntiso 
     174
     175   !--- Type of water isotopes:
     176   iso_eau = strIdx(isoName, 'H2[16]O'); CALL msg('iso_eau='//int2str(iso_eau), modname)
     177   iso_HDO = strIdx(isoName, 'H[2]HO');  CALL msg('iso_HDO='//int2str(iso_HDO), modname)
     178   iso_O18 = strIdx(isoName, 'H2[18]O'); CALL msg('iso_O18='//int2str(iso_O18), modname)
     179   iso_O17 = strIdx(isoName, 'H2[17]O'); CALL msg('iso_O17='//int2str(iso_O17), modname)
     180   iso_HTO = strIdx(isoName, 'H[3]HO');  CALL msg('iso_HTO='//int2str(iso_HTO), modname)
     181
     182   !--- Initialiaation: reading the isotopic parameters.
     183   CALL get_in('lambda',     lambda_sursat, 0.004)
     184   CALL get_in('thumxt1',    thumxt1,       0.75*1.2)
     185   CALL get_in('ntot',       ntot,          20,  .FALSE.)
     186   CALL get_in('h_land_ice', h_land_ice,    20., .FALSE.)
     187   CALL get_in('P_veg',      P_veg,         1.0, .FALSE.)
     188   CALL get_in('bidouille_anti_divergence', bidouille_anti_divergence, .FALSE.)
     189   CALL get_in('essai_convergence',         essai_convergence,         .FALSE.)
     190   CALL get_in('initialisation_iso',        initialisation_iso,        0)
     191
     192!  IF(nzone>0 .AND. initialisation_iso==0) &
     193!      CALL get_in('initialisation_isotrac',initialisation_isotrac)
     194   CALL get_in('modif_sst',      modif_sst,         0)
     195   CALL get_in('deltaTtest',     deltaTtest,      0.0)     !--- For modif_sst>=1
     196   CALL get_in('deltaTtestpoles',deltaTtestpoles, 0.0)     !--- For modif_sst>=2
     197   CALL get_in( 'sstlatcrit',    sstlatcrit,     30.0)     !--- For modif_sst>=3
     198   CALL get_in('dsstlatcrit',   dsstlatcrit,      0.0)     !--- For modif_sst>=3
    340199#ifdef ISOVERIF
    341       !call iso_verif_positif(sstlatcrit,'iso_init 107')
    342       if (sstlatcrit.lt.0.0) then
    343         write(*,*) 'iso_init 270: sstlatcrit=',sstlatcrit
    344         stop
    345       endif
     200   CALL msg('iso_init 270:  sstlatcrit='//real2str( sstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=2
     201   CALL msg('iso_init 279: dsstlatcrit='//real2str(dsstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=3
     202   IF(modif_sst >= 2 .AND. sstlatcrit < 0.0) STOP
    346203#endif             
    347   if (modif_sst.ge.3) then 
    348       call getin_p('dsstlatcrit',dsstlatcrit)
     204
     205   CALL get_in('modif_sic', modif_sic,  0)
     206   IF(modif_sic >= 1) &
     207   CALL get_in('deltasic',  deltasic, 0.1)
     208
     209   CALL get_in('albedo_prescrit', albedo_prescrit, 0)
     210   IF(albedo_prescrit == 1) THEN
     211      CALL get_in('lon_min_albedo', lon_min_albedo, -200.)
     212      CALL get_in('lon_max_albedo', lon_max_albedo,  200.)
     213      CALL get_in('lat_min_albedo', lat_min_albedo, -100.)
     214      CALL get_in('lat_max_albedo', lat_max_albedo,  100.)
     215   END IF
     216   deltaO18_oce=0.0
     217   CALL get_in('deltaP_BL',           deltaP_BL,     10.0)
     218   CALL get_in('ruissellement_pluie', ruissellement_pluie, 0)
     219   CALL get_in('alphak_stewart',      alphak_stewart,      1)
     220   CALL get_in('tdifexp_sol',         tdifexp_sol,      0.67)
     221   CALL get_in('calendrier_guide',    calendrier_guide,    0)
     222   CALL get_in('cste_surf_cond',      cste_surf_cond,      0)
     223   CALL get_in('mixlen',              mixlen,           35.0)
     224   CALL get_in('evap_cont_cste',      evap_cont_cste,      0)
     225   CALL get_in('deltaO18_evap_cont',  deltaO18_evap_cont,0.0)
     226   CALL get_in('d_evap_cont',         d_evap_cont,       0.0)
     227   CALL get_in('nudge_qsol',          nudge_qsol,          0)
     228   CALL get_in('region_nudge_qsol',   region_nudge_qsol,   1)
     229   nlevmaxO17 = 50
     230   CALL msg('nlevmaxO17='//TRIM(int2str(nlevmaxO17)))
     231   CALL get_in('no_pce',   no_pce,     0)
     232   CALL get_in('A_satlim', A_satlim, 1.0)
     233   CALL get_in('ok_restrict_A_satlim', ok_restrict_A_satlim, 0)
    349234#ifdef ISOVERIF
    350       !call iso_verif_positif(dsstlatcrit,'iso_init 110')
    351       if (sstlatcrit.lt.0.0) then
    352         write(*,*) 'iso_init 279: dsstlatcrit=',dsstlatcrit
    353         stop
    354       endif
    355 #endif             
    356   endif !if (modif_sst.ge.3) then
    357 endif !if (modif_sst.ge.2) then
    358 endif !  if (modif_sst.ge.1) then   
    359 call getin_p('modif_sic',modif_sic)
    360 if (modif_sic.ge.1) then
    361 call getin_p('deltasic',deltasic)
    362 endif !if (modif_sic.ge.1) then
    363 
    364 call getin_p('albedo_prescrit',albedo_prescrit)
    365 call getin_p('lon_min_albedo',lon_min_albedo)
    366 call getin_p('lon_max_albedo',lon_max_albedo)
    367 call getin_p('lat_min_albedo',lat_min_albedo)
    368 call getin_p('lat_max_albedo',lat_max_albedo)
    369 call getin_p('deltaO18_oce',deltaO18_oce)
    370 call getin_p('deltaP_BL',deltaP_BL)
    371 call getin_p('ruissellement_pluie',ruissellement_pluie)
    372 call getin_p('alphak_stewart',alphak_stewart)
    373 call getin_p('tdifexp_sol',tdifexp_sol)
    374 call getin_p('calendrier_guide',calendrier_guide)
    375 call getin_p('cste_surf_cond',cste_surf_cond)
    376 call getin_p('mixlen',mixlen)
    377 call getin_p('evap_cont_cste',evap_cont_cste)
    378 call getin_p('deltaO18_evap_cont',deltaO18_evap_cont)
    379 call getin_p('d_evap_cont',d_evap_cont) 
    380 call getin_p('nudge_qsol',nudge_qsol)
    381 call getin_p('region_nudge_qsol',region_nudge_qsol)
    382 call getin_p('no_pce',no_pce)
    383 call getin_p('A_satlim',A_satlim)
    384 call getin_p('ok_restrict_A_satlim',ok_restrict_A_satlim)
    385 #ifdef ISOVERIF     
    386 !call iso_verif_positif(1.0-A_satlim,'iso_init 158')
    387       if (A_satlim.gt.1.0) then
    388         write(*,*) 'iso_init 315: A_satlim=',A_satlim
    389         stop
    390       endif
    391 #endif         
    392 !      call getin_p('slope_limiterxy',slope_limiterxy)
    393 !      call getin_p('slope_limiterz',slope_limiterz)
    394 call getin_p('modif_ratqs',modif_ratqs)
    395 call getin_p('Pcrit_ratqs',Pcrit_ratqs)
    396 call getin_p('ratqsbasnew',ratqsbasnew)
    397 call getin_p('fac_modif_evaoce',fac_modif_evaoce)
    398 call getin_p('ok_bidouille_wake',ok_bidouille_wake)
    399 call getin_p('cond_temp_env',cond_temp_env)
    400 if (use_iso(iso_HTO_possible)) then
    401   ok_prod_nucl_tritium=.true.
    402   call getin_p('ok_prod_nucl_tritium',ok_prod_nucl_tritium)
    403 endif
    404 
    405 write(*,*) 'lambda,thumxt1=',lambda_sursat,thumxt1
    406 write(*,*) 'bidouille_anti_divergence=',bidouille_anti_divergence
    407 write(*,*) 'essai_convergence=',essai_convergence
    408 write(*,*) 'initialisation_iso=',initialisation_iso
    409 write(*,*) 'modif_sst=',modif_sst
    410 if (modif_sst.ge.1) then
    411 write(*,*) 'deltaTtest=',deltaTtest
    412 if (modif_sst.ge.2) then 
    413 write(*,*) 'deltaTtestpoles,sstlatcrit=', &
    414 &           deltaTtestpoles,sstlatcrit
    415 if (modif_sst.ge.3) then   
    416  write(*,*) 'dsstlatcrit=',dsstlatcrit
    417 endif !if (modif_sst.ge.3) then
    418 endif !if (modif_sst.ge.2) then
    419 endif !if (modif_sst.ge.1) then
    420 write(*,*) 'modif_sic=',modif_sic
    421 if (modif_sic.ge.1) then 
    422 write(*,*) 'deltasic=',deltasic
    423 endif !if (modif_sic.ge.1) then
    424 write(*,*) 'deltaO18_oce=',deltaO18_oce
    425 write(*,*) 'albedo_prescrit=',albedo_prescrit
    426 if (albedo_prescrit.eq.1) then
    427  write(*,*) 'lon_min_albedo,lon_max_albedo=', &
    428 &           lon_min_albedo,lon_max_albedo
    429  write(*,*) 'lat_min_albedo,lat_max_albedo=', &
    430 &           lat_min_albedo,lat_max_albedo
    431 endif !if (albedo_prescrit.eq.1) then
    432 write(*,*) 'deltaP_BL,ruissellement_pluie,alphak_stewart=', &
    433 &       deltaP_BL,ruissellement_pluie,alphak_stewart
    434 write(*,*) 'cste_surf_cond=',cste_surf_cond
    435 write(*,*) 'mixlen=',mixlen
    436 write(*,*) 'tdifexp_sol=',tdifexp_sol
    437 write(*,*) 'calendrier_guide=',calendrier_guide
    438 write(*,*) 'evap_cont_cste=',evap_cont_cste
    439 write(*,*) 'deltaO18_evap_cont,d_evap_cont=', &
    440 &           deltaO18_evap_cont,d_evap_cont
    441 write(*,*) 'nudge_qsol,region_nudge_qsol=', &
    442 &  nudge_qsol,region_nudge_qsol 
    443 write(*,*) 'nlevmaxO17=',nlevmaxO17
    444 write(*,*) 'no_pce=',no_pce
    445 write(*,*) 'A_satlim=',A_satlim
    446 write(*,*) 'ok_restrict_A_satlim=',ok_restrict_A_satlim
    447 !      write(*,*) 'slope_limiterxy=',slope_limiterxy
    448 !      write(*,*) 'slope_limiterz=',slope_limiterz
    449 write(*,*) 'modif_ratqs=',modif_ratqs
    450 write(*,*) 'Pcrit_ratqs=',Pcrit_ratqs
    451 write(*,*) 'ratqsbasnew=',ratqsbasnew
    452 write(*,*) 'fac_modif_evaoce=',fac_modif_evaoce
    453 write(*,*) 'ok_bidouille_wake=',ok_bidouille_wake
    454 write(*,*) 'cond_temp_env=',cond_temp_env
    455 write(*,*) 'ok_prod_nucl_tritium=',ok_prod_nucl_tritium
    456          
    457 
    458 !--------------------------------------------------------------
    459 ! Parameters that do not depend on the nature of water isotopes:
    460 !--------------------------------------------------------------
    461 
    462 ! -- temperature at which ice condensate starts to form (valeur ECHAM?):
    463 pxtmelt=273.15
    464 !      pxtmelt=273.15-10.0 ! test PHASE
    465 
    466 ! -- temperature at which all condensate is ice:
    467 pxtice=273.15-10.0
    468 !      pxtice=273.15-30.0 ! test PHASE
    469 
    470 ! -- minimum temperature to calculate fractionation coeff
    471 pxtmin=273.15-120.0 ! On ne calcule qu'au dessus de -120°C
    472 pxtmax=273.15+60.0 ! On ne calcule qu'au dessus de +60°C
    473 ! remarque: les coeffs ont été mesurés seulement jusq'à -40!
    474 
    475 ! -- a constant for alpha_eff for equilibrium below cloud base:
    476 tdifexp=0.58
    477 tv0cin=7.0
    478 
    479 ! facteurs lambda et mu dans Si=musi-lambda*T
    480 musi=1.0
    481 if (ok_nocinsat) then
    482 lambda_sursat = 0.0 ! no sursaturation effect
    483 endif           
    484 
    485 
    486 ! diffusion dans le sol
    487 Kd=2.5e-9 ! m2/s   
    488 
    489 ! cas où cste_surf_cond: on met rhs ou/et Ts cste pour voir
    490 rh_cste_surf_cond=0.6
    491 T_cste_surf_cond=288.0
    492 
    493 !--------------------------------------------------------------
    494 ! Parameters that depend on the nature of water isotopes:
    495 !--------------------------------------------------------------
    496 ! ** constantes locales
    497 fac_enrichoce18=0.0005
    498 ! on a alors tcor018=1+fac_enrichoce18
    499 ! tcorD=1+fac_enrichoce18*8
    500 ! tcorO17=1+fac_enrichoce18*0.528
    501 alpha_liq_sol_O18=1.00291 ! valeur de Lehmann & Siegenthaler, 1991,
    502   ! Journal of Glaciology, vol 37, p 23
    503 talph1_O18=1137.
    504 talph2_O18=-0.4156
    505 talph3_O18=-2.0667E-3
    506 talps1_O18=11.839
    507 talps2_O18=-0.028244
    508 tkcin0_O18 = 0.006
    509 tkcin1_O18 = 0.000285
    510 tkcin2_O18 = 0.00082
    511 tdifrel_O18= 1./0.9723
    512 
    513 ! rapport des ln(alphaeq) entre O18 et O17
    514 fac_coeff_eq17_liq=0.529 ! donné par Amaelle
    515 !      fac_coeff_eq17_ice=0.528 ! slope MWL
    516 fac_coeff_eq17_ice=0.529
    517 
    518 
    519 write(*,*) 'iso_O18,iso_HDO,iso_eau=',iso_O18,iso_HDO,iso_eau
    520 do 999 ixt = 1, niso
    521 write(*,*) 'iso_init 80: ixt=',ixt
    522 
    523 
    524 ! -- kinetic factor for surface evaporation:
    525 ! (cf: kcin = tkcin0                  if |V|<tv0cin
    526 !      kcin = tkcin1*|Vsurf| + tkcin2 if |V|>tv0cin )
    527 ! (Rq: formula discontinuous for |V|=tv0cin... )       
    528 
    529 ! -- main:
    530 if (ixt.eq.iso_HTO) then ! Tritium
    531   tkcin0(ixt) = 0.01056
    532   tkcin1(ixt) = 0.0005016
    533   tkcin2(ixt) = 0.0014432
    534   tnat(ixt)=0.
    535   !toce(ixt)=2.2222E-8 ! corrigé par Alex Cauquoin
    536   !toce(ixt)=1.0E-18 ! rapport 3H/1H ocean
    537   toce(ixt)=4.0E-19 ! rapport T/H = 0.2 TU Dreisigacker and Roether 1978
    538   tcorr(ixt)=1.
    539   tdifrel(ixt)=1./0.968
    540   talph1(ixt)=46480.
    541   talph2(ixt)=-103.87
    542   talph3(ixt)=0.
    543   talps1(ixt)=46480.
    544   talps2(ixt)=-103.87
    545   alpha_liq_sol(ixt)=1.
    546   Rdefault(ixt)=0.0
    547   Rmethox(ixt)=0.0
    548   striso(ixt)='HTO'
    549 endif     
    550 if (ixt.eq.iso_O17) then ! Deuterium
    551   pente_MWL=0.528
    552 !          tdifrel(ixt)=1./0.985452 ! donné par Amaelle
    553   tdifrel(ixt)=1./0.98555 ! valeur utilisée en 1D et dans modèle de LdG
    554 !          fac_kcin=0.5145 ! donné par Amaelle
    555   fac_kcin= (tdifrel(ixt)-1.0)/(tdifrel_O18-1.0)
    556   tkcin0(ixt) = tkcin0_O18*fac_kcin
    557   tkcin1(ixt) = tkcin1_O18*fac_kcin
    558   tkcin2(ixt) = tkcin2_O18*fac_kcin
    559   tnat(ixt)=0.004/100. ! O17 représente 0.004% de l'oxygène
    560   toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)**pente_MWL
    561   tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL ! donné par Amaelle           
    562   talph1(ixt)=talph1_O18
    563   talph2(ixt)=talph2_O18
    564   talph3(ixt)=talph3_O18
    565   talps1(ixt)=talps1_O18
    566   talps2(ixt)=talps2_O18     
    567   alpha_liq_sol(ixt)=(alpha_liq_sol_O18)**fac_coeff_eq17_liq
    568   if (Rdefault_smow) then   
    569         Rdefault(ixt)=tnat(ixt)*(-3.15/1000.0+1.0)
    570   else
    571         Rdefault(ixt)=0.0
    572   endif
    573   Rmethox(ixt)=(230./1000.+1.)*tnat(ixt) !Zahn et al 2006
    574   striso(ixt)='O17'
    575 endif
    576 
    577 if (ixt.eq.iso_O18) then ! Oxygene18
    578   tkcin0(ixt) = tkcin0_O18
    579   tkcin1(ixt) = tkcin1_O18
    580   tkcin2(ixt) = tkcin2_O18
    581   tnat(ixt)=2005.2E-6
    582   toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)
    583   tcorr(ixt)=1.0+fac_enrichoce18
    584   tdifrel(ixt)=tdifrel_O18
    585   talph1(ixt)=talph1_O18
    586   talph2(ixt)=talph2_O18
    587   talph3(ixt)=talph3_O18
    588   talps1(ixt)=talps1_O18
    589   talps2(ixt)=talps2_O18
    590   alpha_liq_sol(ixt)=alpha_liq_sol_O18   
    591   if (Rdefault_smow) then   
    592         Rdefault(ixt)=tnat(ixt)*(-6.0/1000.0+1.0)
    593   else
    594         Rdefault(ixt)=0.0
    595   endif
    596   Rmethox(ixt)=(130./1000.+1.)*tnat(ixt) !Zahn et al 2006   
    597 !       write(*,*) 'iso_init 163: ZXalpha_liq_sol=',ZXalpha_liq_sol
    598   striso(ixt)='O18'
    599   write(*,*) 'isotopes_mod 519: ixt,striso(ixt)=',ixt,striso(ixt)
    600 endif
    601 
    602 if (ixt.eq.iso_HDO) then ! Deuterium
    603   pente_MWL=8.0
    604 !          fac_kcin=0.88
    605   tdifrel(ixt)=1./0.9755
    606   fac_kcin= (tdifrel(ixt)-1)/(tdifrel_O18-1)
    607   tkcin0(ixt) = tkcin0_O18*fac_kcin
    608   tkcin1(ixt) = tkcin1_O18*fac_kcin
    609   tkcin2(ixt) = tkcin2_O18*fac_kcin
    610   tnat(ixt)=155.76E-6
    611   toce(ixt)=tnat(ixt)*(1.0+pente_MWL*deltaO18_oce/1000.0)
    612   tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL         
    613   talph1(ixt)=24844.
    614   talph2(ixt)=-76.248
    615   talph3(ixt)=52.612E-3
    616   talps1(ixt)=16288.
    617   talps2(ixt)=-0.0934
    618   !ZXalpha_liq_sol=1.0192 ! Weston, Ralph, 1955
    619   alpha_liq_sol(ixt)=1.0212
    620   ! valeur de Lehmann & Siegenthaler, 1991, Journal of
    621   ! Glaciology, vol 37, p 23
    622   if (Rdefault_smow) then   
    623     Rdefault(ixt)=tnat(ixt)*((-6.0*pente_MWL+10.0)/1000.0+1.0)
    624   else
    625     Rdefault(ixt)=0.0
    626   endif
    627   Rmethox(ixt)=tnat(ixt)*(-25.0/1000.+1.) ! Zahn et al 2006
    628   striso(ixt)='HDO'
    629   write(*,*) 'isotopes_mod 548: ixt,striso(ixt)=',ixt,striso(ixt)
    630 endif
    631 
    632 !       write(*,*) 'iso_init 163: ZXalpha_liq_sol=',ZXalpha_liq_sol
    633 if (ixt.eq.iso_eau) then ! Oxygene16
    634   tkcin0(ixt) = 0.0
    635   tkcin1(ixt) = 0.0
    636   tkcin2(ixt) = 0.0
    637   tnat(ixt)=1.
    638   toce(ixt)=tnat(ixt)
    639   tcorr(ixt)=1.0
    640   tdifrel(ixt)=1.
    641   talph1(ixt)=0.
    642   talph2(ixt)=0.
    643   talph3(ixt)=0.
    644   talps1(ixt)=0.
    645   talph3(ixt)=0.
    646   alpha_liq_sol(ixt)=1.
    647   if (Rdefault_smow) then
    648         Rdefault(ixt)=tnat(ixt)*1.0
    649   else
    650         Rdefault(ixt)=1.0
    651   endif
    652   Rmethox(ixt)=1.0
    653   striso(ixt)='eau'
    654 endif
    655 
    656 999   continue
    657 
    658 ! test de sensibilité:
    659 if (ok_nocinsfc) then ! no kinetic effect in sfc evaporation
    660  do ixt=1,niso
    661   tkcin0(ixt) = 0.0
    662   tkcin1(ixt) = 0.0
    663   tkcin2(ixt) = 0.0
    664  enddo
    665 endif
    666 
    667 ! fermeture fichier de paramètres
    668 close(unit=32)
    669 
    670 ! nom des isotopes
    671 
    672 ! verif
    673 write(*,*) 'iso_init 285: verif initialisation:'
    674 
    675 do ixt=1,niso
    676   write(*,*) '* striso(',ixt,')=<'//striso(ixt)//'>'
    677   write(*,*) 'tnat(',ixt,')=',tnat(ixt)
    678 !          write(*,*) 'alpha_liq_sol(',ixt,')=',alpha_liq_sol(ixt)
    679 !          write(*,*) 'tkcin0(',ixt,')=',tkcin0(ixt)
    680 !          write(*,*) 'tdifrel(',ixt,')=',tdifrel(ixt)
    681 enddo
    682 write(*,*) 'iso_init 69: lambda=',lambda_sursat
    683 write(*,*) 'iso_init 69: thumxt1=',thumxt1
    684 write(*,*) 'iso_init 69: h_land_ice=',h_land_ice
    685 write(*,*) 'iso_init 69: P_veg=',P_veg   
    686 
    687     return
     235   CALL msg(' 315: A_satlim='//real2str(A_satlim), modname, A_satlim > 1.0)
     236   IF(A_satlim > 1.0) STOP
     237#endif
     238!  CALL get_in('slope_limiterxy',   slope_limiterxy,  2.0)
     239!  CALL get_in('slope_limiterz',    slope_limiterz,   2.0)
     240   CALL get_in('modif_ratqs',       modif_ratqs,        0)
     241   CALL get_in('Pcrit_ratqs',       Pcrit_ratqs,    500.0)
     242   CALL get_in('ratqsbasnew',       ratqsbasnew,     0.05)
     243   CALL get_in('fac_modif_evaoce',  fac_modif_evaoce, 1.0)
     244   CALL get_in('ok_bidouille_wake', ok_bidouille_wake,  0)
     245   ! si oui, la temperature de cond est celle de l'environnement, pour eviter
     246   ! bugs quand temperature dans ascendances convs est mal calculee
     247   CALL get_in('cond_temp_env',        cond_temp_env,        .FALSE.)
     248   IF(ANY(isoName == 'H[3]HO')) &
     249   CALL get_in('ok_prod_nucl_tritium', ok_prod_nucl_tritium, .FALSE., .FALSE.)
     250
     251   !--------------------------------------------------------------
     252   ! Parameters that do not depend on the nature of water isotopes:
     253   !--------------------------------------------------------------
     254   ! -- temperature at which ice condensate starts to form (valeur ECHAM?):
     255   pxtmelt = 273.15
     256
     257   ! -- temperature at which all condensate is ice:
     258   pxtice  = 273.15-10.0
     259
     260   !- -- test PHASE
     261!   pxtmelt = 273.15 - 10.0
     262!   pxtice  = 273.15 - 30.0
     263
     264   ! -- minimum temperature to calculate fractionation coeff
     265   pxtmin = 273.15 - 120.0   ! On ne calcule qu'au dessus de -120°C
     266   pxtmax = 273.15 +  60.0   ! On ne calcule qu'au dessus de +60°C
     267   !    Remarque: les coeffs ont ete mesures seulement jusq'à -40!
     268
     269   ! -- a constant for alpha_eff for equilibrium below cloud base:
     270   tdifexp = 0.58
     271   tv0cin  = 7.0
     272
     273   ! facteurs lambda et mu dans Si=musi-lambda*T
     274   musi=1.0
     275   if (ok_nocinsat) lambda_sursat = 0.0          ! no sursaturation effect
     276
     277   ! diffusion dans le sol
     278   Kd=2.5e-9 ! m2/s   
     279
     280   ! cas où cste_surf_cond: on met rhs ou/et Ts cste pour voir
     281   rh_cste_surf_cond = 0.6
     282    T_cste_surf_cond = 288.0
     283   
     284   CALL msg('iso_O18, iso_HDO, iso_eau = '//TRIM(strStack(int2str([iso_O18, iso_HDO, iso_eau]))), modname)
     285
     286   !--------------------------------------------------------------
     287   ! Parameters that depend on the nature of water isotopes:
     288   !--------------------------------------------------------------
     289   IF(getKey('tnat',    tnat,    isoName)) CALL abort_physic(modname, 'can''t get tnat',    1)
     290   IF(getKey('toce',    toce,    isoName)) CALL abort_physic(modname, 'can''t get toce',    1)
     291   IF(getKey('tcorr',   tcorr,   isoName)) CALL abort_physic(modname, 'can''t get tcorr',   1)
     292   IF(getKey('talph1',  talph1,  isoName)) CALL abort_physic(modname, 'can''t get talph1',  1)
     293   IF(getKey('talph2',  talph2,  isoName)) CALL abort_physic(modname, 'can''t get talph2',  1)
     294   IF(getKey('talph3',  talph3,  isoName)) CALL abort_physic(modname, 'can''t get talph3',  1)
     295   IF(getKey('talps1',  talps1,  isoName)) CALL abort_physic(modname, 'can''t get talps1',  1)
     296   IF(getKey('talps2',  talps2,  isoName)) CALL abort_physic(modname, 'can''t get talps2',  1)
     297   IF(getKey('tkcin0',  tkcin0,  isoName)) CALL abort_physic(modname, 'can''t get tkcin0',  1)
     298   IF(getKey('tkcin1',  tkcin1,  isoName)) CALL abort_physic(modname, 'can''t get tkcin1',  1)
     299   IF(getKey('tkcin2',  tkcin2,  isoName)) CALL abort_physic(modname, 'can''t get tkcin2',  1)
     300   IF(getKey('tdifrel', tdifrel, isoName)) CALL abort_physic(modname, 'can''t get tdifrel', 1)
     301   IF(getKey('alpha_liq_sol', alpha_liq_sol, isoName)) CALL abort_physic(modname, 'can''t get alpha_liq_sol',  1)
     302   IF(getKey('Rdefault',Rdefault,isoName)) CALL abort_physic(modname, 'can''t get Rdefault',1)
     303   IF(getKey('Rmethox', Rmethox, isoName)) CALL abort_physic(modname, 'can''t get Rmethox', 1)
     304   IF(.NOT.Rdefault_smow) Rdefault(:) = 0.0
     305
     306   !--- Sensitivity test: no kinetic effect in sfc evaporation
     307   IF(ok_nocinsfc) THEN
     308      tkcin0(1:niso) = 0.0
     309      tkcin1(1:niso) = 0.0
     310      tkcin2(1:niso) = 0.0
     311   END IF
     312
     313   CALL msg('285: verif initialisation:', modname)
     314   DO ixt=1,niso
     315      sxt=int2str(ixt)
     316      CALL msg(' * isoName('//TRIM(sxt)//') = <'//TRIM(isoName(ixt))//'>',  modname)
     317      CALL msg(  '    tnat('//TRIM(sxt)//') = '//TRIM(real2str(tnat(ixt))), modname)
     318!     CALL msg('    alpha_liq_sol('//TRIM(sxt)//') = '//TRIM(real2str(alpha_liq_sol(ixt))), modname)
     319!     CALL msg(        '   tkcin0('//TRIM(sxt)//') = '//TRIM(real2str(tkcin0(ixt))),        modname)
     320!     CALL msg(       '   tdifrel('//TRIM(sxt)//') = '//TRIM(real2str(tdifrel(ixt))),       modname)
     321   END DO
     322   CALL msg('69:     lambda = '//TRIM(real2str(lambda_sursat)), modname)
     323   CALL msg('69:    thumxt1 = '//TRIM(real2str(thumxt1)),       modname)
     324   CALL msg('69: h_land_ice = '//TRIM(real2str(h_land_ice)),    modname)
     325   CALL msg('69:      P_veg = '//TRIM(real2str(P_veg)),         modname)
     326
    688327END SUBROUTINE iso_init
    689328
     329
     330SUBROUTINE getinp_s(nam, val, def, lDisp)
     331   USE ioipsl_getincom, ONLY: getin
     332   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     333   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     334   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     335   CHARACTER(LEN=*),           INTENT(IN)    :: nam
     336   CHARACTER(LEN=*),           INTENT(INOUT) :: val
     337   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)    :: def
     338   LOGICAL,          OPTIONAL, INTENT(IN)    :: lDisp
     339   LOGICAL :: lD
     340!$OMP BARRIER
     341   IF(is_mpi_root.AND.is_omp_root) THEN
     342      IF(PRESENT(def)) val=def; CALL getin(nam,val)
     343      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     344      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(val))
     345  END IF
     346  CALL bcast(val)
     347END SUBROUTINE getinp_s
     348
     349SUBROUTINE getinp_i(nam, val, def, lDisp)
     350   USE ioipsl_getincom, ONLY: getin
     351   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     352   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     353   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     354   CHARACTER(LEN=*),  INTENT(IN)    :: nam
     355   INTEGER,           INTENT(INOUT) :: val
     356   INTEGER, OPTIONAL, INTENT(IN)    :: def
     357   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     358   LOGICAL :: lD
     359!$OMP BARRIER
     360   IF(is_mpi_root.AND.is_omp_root) THEN
     361      IF(PRESENT(def)) val=def; CALL getin(nam,val)
     362      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     363      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(int2str(val)))
     364  END IF
     365  CALL bcast(val)
     366END SUBROUTINE getinp_i
     367
     368SUBROUTINE getinp_r(nam, val, def, lDisp)
     369   USE ioipsl_getincom, ONLY: getin
     370   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     371   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     372   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     373   CHARACTER(LEN=*),  INTENT(IN)    :: nam
     374   REAL,              INTENT(INOUT) :: val
     375   REAL,    OPTIONAL, INTENT(IN)    :: def
     376   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     377   LOGICAL :: lD
     378!$OMP BARRIER
     379   IF(is_mpi_root.AND.is_omp_root) THEN
     380      IF(PRESENT(def)) val=def; CALL getin(nam,val)
     381      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     382      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(real2str(val)))
     383  END IF
     384  CALL bcast(val)
     385END SUBROUTINE getinp_r
     386
     387SUBROUTINE getinp_l(nam, val, def, lDisp)
     388   USE ioipsl_getincom, ONLY: getin
     389   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     390   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     391   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     392   CHARACTER(LEN=*),  INTENT(IN)    :: nam
     393   LOGICAL,           INTENT(INOUT) :: val
     394   LOGICAL, OPTIONAL, INTENT(IN)    :: def
     395   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     396   LOGICAL :: lD
     397!$OMP BARRIER
     398   IF(is_mpi_root.AND.is_omp_root) THEN
     399      IF(PRESENT(def)) val=def; CALL getin(nam,val)
     400      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     401      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(bool2str(val)))
     402  END IF
     403  CALL bcast(val)
     404END SUBROUTINE getinp_l
    690405
    691406END MODULE isotopes_mod

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/isotopes_routines_mod.F90

    r3927 r4368  
    33
    44MODULE isotopes_routines_mod
     5  USE infotrac_phy, ONLY: niso, ntraciso=>ntiso, index_trac=>itZonIso, ntraceurs_zone=>nzone
    56IMPLICIT NONE
    67
    … …  
    1314&            zqs,zq_ancien,zqev_diag,zq)
    1415
    15 USE infotrac_phy, ONLY: ntraciso,niso, &
    16         ntraceurs_zone,index_trac
    1716USE isotopes_mod, ONLY: ridicule, ridicule_rain, thumxt1, no_pce,  &
    1817&       bidouille_anti_divergence, &
    … …  
    846845&    L, xtnu,Pveg)
    847846
    848 USE infotrac_phy, ONLY: niso
    849847USE isotopes_mod, ONLY: ridicule_qsol, ridicule, &
    850848&       ridicule_evap,P_veg,iso_HDO,iso_eau,iso_O17,iso_O18
    … …  
    13011299
    13021300subroutine calcul_kcin(Vsurf,KCIN)
    1303 USE infotrac_phy, ONLY: niso
    13041301USE isotopes_mod, ONLY: tv0cin,tkcin0,tkcin1,tkcin2
    13051302implicit none
    … …  
    13281325
    13291326     subroutine fractcalk(kt, ptin, pxtfra, pfraice)
    1330 !USE infotrac_phy, ONLY: use_iso
    13311327USE isotopes_mod, ONLY: talph1,talph2,talph3,pxtmin,iso_O17, &
    13321328&       fac_coeff_eq17_liq, pxtmelt, &
    … …  
    14571453      subroutine fractcalk_liq(kt, ptin, pxtfra)
    14581454
    1459 !      USE infotrac_phy, ONLY: use_iso
    14601455      USE isotopes_mod, ONLY: pxtmin,talph1,talph2,talph3, &
    14611456&       fac_coeff_eq17_liq, pxtice, &
    … …  
    15221517      subroutine fractcalk_glace(kt, ptin, pfraice)
    15231518
    1524 !      use infotrac_phy, ONLY: use_iso
    15251519      use isotopes_mod, ONLY: talps1,talps2, iso_O17,fac_coeff_eq17_ice, &
    15261520        & pxtmelt,musi, lambda_sursat, tdifrel, &
    … …  
    16311625      subroutine fractcalk_vectall(ptin, pxtfra, pfraice,n)
    16321626
    1633         USE infotrac_phy, ONLY: niso
    16341627        USE isotopes_mod, ONLY: talph1,talph2,talph3,tdifrel,pxtmin, &
    16351628&      iso_O17, iso_HTO, iso_eau, iso_O18, iso_HDO, musi, lambda_sursat, &
    … …  
    18031796      subroutine fractcalk_vectall_liq(ptin, pxtfra, n)
    18041797
    1805       USE infotrac_phy, ONLY: niso
    18061798      USE isotopes_mod, ONLY: pxtmin,talph1,talph2,talph3, &
    18071799&       iso_eau,iso_HDO, iso_O18, iso_O17,iso_HTO,fac_coeff_eq17_liq, &
    … …  
    18821874      subroutine fractcalk_vectall_ice(ptin, pfraice,n)
    18831875
    1884       use infotrac_phy, ONLY: niso
    18851876      use isotopes_mod, ONLY: talps1,talps2, fac_coeff_eq17_ice, &
    18861877        & pxtmelt,musi, lambda_sursat, tdifrel, &
    … …  
    20232014&            i,Rsol,klon)
    20242015
    2025   USE infotrac_phy, ONLY: niso,ntraciso
    20262016  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule, &
    20272017&        ridicule_qsol,iso_O17,iso_O18
    … …  
    22332223&          i,xtevap,klon) 
    22342224
    2235   USE infotrac_phy, ONLY: ntraciso,niso
    22362225  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule,ridicule_rain, &
    22372226        iso_O18,iso_O17
    … …  
    24442433&   )
    24452434
    2446   USE infotrac_phy, ONLY: ntraciso,niso
    24472435  USE isotopes_mod, ONLY: iso_eau, iso_HDO,expb_max,tdifrel,tdifexp, &
    24482436&       ridicule,thumxt1,ridicule_rain,bidouille_anti_divergence, &
    … …  
    45004488&           Tevap)
    45014489
    4502   USE infotrac_phy, ONLY: niso,ntraciso
    45034490  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
    45044491&       ridicule,ridicule_rain
    … …  
    46584645&           ,fac_ftmr)
    46594646
    4660   USE infotrac_phy, ONLY: niso,ntraciso
    46614647  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
    46624648&       Rdefault,ridicule,ridicule_rain
    … …  
    49044890     &           Pqiinf_cas,Pqiinf)
    49054891
    4906   USE infotrac_phy, ONLY: niso,ntraciso
    49074892  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    49084893
    … …  
    50665051     &           xtnew_cas,xtnew,Pxtiinf_cas,Pxtiinf)
    50675052
    5068   USE infotrac_phy, ONLY: niso
    50695053  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    50705054#ifdef ISOVERIF
    … …  
    51115095     &           ncum)
    51125096
    5113   USE infotrac_phy, ONLY: niso,ntraciso
    51145097  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    51155098
    … …  
    51765159     &    nloc,ncum,nd,i)
    51775160
    5178   USE infotrac_phy, ONLY: niso, ntraciso
    51795161  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    51805162
    … …  
    52525234     &    nloc,ncum,nd,i)
    52535235
    5254   USE infotrac_phy, ONLY: niso,ntraciso
    52555236  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    52565237
    … …  
    53265307     &    nloc,ncum,nd,i)
    53275308
    5328   USE infotrac_phy, ONLY: niso,ntraciso
    53295309  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    53305310
    … …  
    53965376     &    nloc,ncum,nd,i)
    53975377
    5398   USE infotrac_phy, ONLY: niso,ntraciso
    53995378  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule
    54005379
    … …  
    55665545     &    nloc,ncum,nd,i,frac_sublim)
    55675546
    5568   USE infotrac_phy, ONLY: niso,ntraciso
    55695547  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule
    55705548
    … …  
    57035681     &       zxtrfln_cas,zxt_cas,zxtrfl,zxtrfln,zxt,klon)
    57045682
    5705   USE infotrac_phy, ONLY: niso,ntraciso
    57065683  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    57075684
    … …  
    57395716     &       delP,paprs,k,klon,klev)
    57405717
    5741   USE infotrac_phy, ONLY: niso
    57425718  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    57435719         implicit none
    … …  
    57775753     &       delP,paprs,k,klon,klev)
    57785754
    5779   USE infotrac_phy, ONLY: niso,ntraciso
    57805755  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    57815756         implicit none
    … …  
    58285803     &       delP,paprs,k,klon,klev,frac_sublim)
    58295804
    5830   USE infotrac_phy, ONLY: niso,ntraciso
    58315805  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    58325806#ifdef ISOVERIF
    … …  
    59055879     &          qp0,A,m0,beta,gama,g0) 
    59065880
    5907   USE infotrac_phy, ONLY: niso
    59085881  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ntot
    59095882#ifdef ISOVERIF
    … …  
    61006073 
    61016074
    6102   USE infotrac_phy, ONLY: ntraciso,niso,ntraceurs_zone, &
    6103 &       index_trac
    61046075  USE isotopes_mod, ONLY: iso_eau, iso_HDO,thumxt1, &
    61056076&       bidouille_anti_divergence,ridicule
    … …  
    63666337              else !if (qp(il,i).gt.0) then
    63676338                  ! si qp est négatif, on met les isos dedans à 0
    6368                 write(*,*) 'appel_stewart temporaire 230: qp=', &
    6369      &        qp(il,i)
    63706339                do ixt=1,ntraciso
    63716340                 xtp_avantevap(ixt,il)=0.0
    … …  
    76827651     &          )   
    76837652
    7684   USE infotrac_phy, ONLY: niso,ntraciso
    76857653  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
    76867654#ifdef ISOVERIF
    … …  
    80508018     &  )
    80518019
    8052   USE infotrac_phy, ONLY: niso,ntraciso
    80538020  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault,ridicule
    80548021#ifdef ISOVERIF
    … …  
    82558222     &          )
    82568223
    8257   USE infotrac_phy, ONLY: niso,ntraciso
    82588224  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault,ridicule
    82598225#ifdef ISOVERIF
    … …  
    83928358     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    83938359
    8394   USE infotrac_phy, ONLY: niso,ntraciso
    83958360  USE isotopes_mod, ONLY: iso_eau, iso_HDO,no_pce, Rdefault,ridicule       
    83968361#ifdef ISOVERIF
    … …  
    89298894     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    89308895
    8931   USE infotrac_phy, ONLY: niso,ntraciso
    89328896  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
    89338897#ifdef ISOVERIF
    … …  
    93199283 
    93209284
    9321   USE infotrac_phy, ONLY: niso,ntraciso, &
    9322 &       ntraceurs_zone,index_trac
    93239285  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
    93249286&       thumxt1, ridicule
    … …  
    95989560              else !if (qp(il,i).gt.0) then
    95999561                  ! si qp est négatif, on met les isos dedans à 0
    9600                 write(*,*) 'appel_stewart_np temporaire 230: qp=', &
    9601      &                         qp(il,i)
    96029562                do ixt=1,ntraciso
    96039563                 xtp_avantevap(ixt,il)=0.0
    … …  
    99819941#ifdef ISOVERIF
    99829942      ! vérif de la compression
    9983       write(*,*) 'appel_stewart_np tmp 506: ', &
    9984      &          'après compress_condensation_facftmr'
     9943!      write(*,*) 'appel_stewart_np tmp 506: ', &
     9944!     &          'après compress_condensation_facftmr'
    99859945!      write(*,*) 'sigd_cas(1:3)=',sigd_cas(1:3)
    9986       if (ncas_condensation_facftmr.ge.4) then
    9987           write(*,*) 'cas_condensation_facftmr(4)=', &
    9988      &          cas_condensation_facftmr(4)
    9989       endif
     9946!      if (ncas_condensation_facftmr.ge.4) then
     9947!          write(*,*) 'cas_condensation_facftmr(4)=', &
     9948!     &          cas_condensation_facftmr(4)
     9949!      endif
    99909950      do il=1,ncas_condensation_facftmr
    99919951        call iso_verif_egalite_choix((Pqisup_cas(il)), &
    … …  
    1015610116#ifdef ISOVERIF
    1015710117      ! vérif de la compression
    10158       write(*,*) 'appel_stewart_np tmp 616: ', &
    10159      &          'apres compress condensation_nofacftmr'
    10160       write(*,*) 'iso_routines 10153: sigd_cas(1:3)=', sigd_cas(1:3)
     10118!      write(*,*) 'appel_stewart_np tmp 616: ', &
     10119!     &          'apres compress condensation_nofacftmr'
     10120!      write(*,*) 'iso_routines 10153: sigd_cas(1:3)=', sigd_cas(1:3)
    1016110121      do il=1,ncas_condensation_nofacftmr
    1016210122        call iso_verif_egalite_choix((Pqisup_cas(il)), &
    … …  
    1024410204       enddo !do izone=1,ntraceurs_zone
    1024510205#ifdef ISOVERIF
    10246        write(*,*) 'appel_stewart_np tmp 690: ', &
    10247      &          'fin du cas condensation_nofacftmr'
     10206!       write(*,*) 'appel_stewart_np tmp 690: ', &
     10207!     &          'fin du cas condensation_nofacftmr'
    1024810208            do il=1,ncas_condensation_nofacftmr
    1024910209               call iso_verif_traceur(xtp &
    … …  
    1072710687
    1072810688#ifdef ISOVERIF
    10729       write(*,*) 'appel_stewart_np tmp 898 après compress glace'
     10689!      write(*,*) 'appel_stewart_np tmp 898 apres compress glace'
    1073010690!      write(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
    1073110691!     &   qp_avantevap_cas(1),qp_avantevap(cas_evap_glace(1))   
    10732       write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
     10692      !write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
    1073310693      ! vérif de la compression
    1073410694      do il=1,ncas_evap_glace
    … …  
    1102610986     &          )
    1102710987
    11028   USE infotrac_phy, ONLY: niso,ntraciso
    1102910988  USE isotopes_mod, ONLY: iso_eau, iso_HDO,Rdefault,ridicule
    1103010989#ifdef ISOVERIF
    … …  
    1117611135     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    1117711136
    11178   USE infotrac_phy, ONLY: niso,ntraciso
    1117911137  USE isotopes_mod, ONLY: iso_eau, iso_HDO,Rdefault,no_pce,ridicule
    1118011138#ifdef ISOVERIF
    … …  
    1131111269     &       fac_ftmr_cas(1))
    1131211270        else !if (no_pce.eq.1) then
    11313 #ifdef ISOVERIF                   
    11314             write(*,*) 'appel_stewart_np 1957 tmp'
    11315 #endif           
     11271           
    1131611272      call stewart_explicite_vectall(ncas, &
    1131711273     &       qp_avantevap_cas(1),xtp_avantevap_cas(1,1), &
    … …  
    1177611732     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    1177711733
    11778   USE infotrac_phy, ONLY: niso,ntraciso
    1177911734  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
    1178011735#ifdef ISOVERIF
    … …  
    1185711812     &       T_cas(1))
    1185811813      else !if (frac_sublim.eq.1) then
    11859 #ifdef ISOVERIF
    11860             write(*,*) 'appel_stewart_explicite_np 2269'
    11861             write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
    11862             write(*,*) 'Pqisup_cas(1)=',Pqisup_cas(1)
    11863             write(*,*) 'Eqi_cas(1)=',Eqi_cas(1)
    11864             write(*,*) 'Eqi_prime_cas(1)=',Eqi_prime_cas(1)
    11865             write(*,*) 'Eqi_stewart(1)=',Eqi_stewart(1)
    11866 #endif         
     11814!#ifdef ISOVERIF
     11815!            write(*,*) 'appel_stewart_explicite_np 2269'
     11816!            write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
     11817!            write(*,*) 'Pqisup_cas(1)=',Pqisup_cas(1)
     11818!            write(*,*) 'Eqi_cas(1)=',Eqi_cas(1)
     11819!            write(*,*) 'Eqi_prime_cas(1)=',Eqi_prime_cas(1)
     11820!            write(*,*) 'Eqi_stewart(1)=',Eqi_stewart(1)
     11821!#endif         
    1186711822            call stewart_sublim_nofrac_vectall( &
    1186811823     &        ncas,qp_avantevap_cas(1), &
    … …  
    1220412159     &          tcond,zfice,zxtice,zxtliq)
    1220512160
    12206     USE infotrac_phy, ONLY: ntraciso,niso
    1220712161    USE isotopes_mod, ONLY: iso_eau,iso_HDO,essai_convergence, &
    1220812162&       bidouille_anti_divergence,ridicule
    … …  
    1243812392     &          tcond,zfice,zxtice,zxtliq,n)
    1243912393
    12440     USE infotrac_phy, ONLY: ntraciso,niso
    1244112394    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,bidouille_anti_divergence, &
    1244212395&       ridicule
    … …  
    1289612849     &          tcond,zfice,zxtice,zxtliq)
    1289712850
    12898     USE infotrac_phy, ONLY: ntraciso
    1289912851    USE isotopes_mod, ONLY: iso_eau,iso_HDO,bidouille_anti_divergence, &
    1290012852&       ridicule,iso_O18
    … …  
    1309413046     &           xt1lay,q1lay,tsurf,t_coup,nisurf,Rland_ice)
    1309513047
    13096     USE infotrac_phy, ONLY: ntraciso,niso
    1309713048    USE isotopes_mod, ONLY: Rdefault,iso_eau,iso_HDO, &
    1309813049&       bidouille_anti_divergence, ridicule,ridicule_snow, &
    … …  
    1366413615     &   )
    1366513616
    13666     USE infotrac_phy, ONLY: ntraciso,niso
    1366713617    USE isotopes_mod, ONLY: iso_eau,iso_HDO,cste_surf_cond, &
    1366813618&       rh_cste_surf_cond,Rdefault,T_cste_surf_cond,iso_O17,iso_O18, &
    … …  
    1398813938     &   )
    1398913939
    13990     USE infotrac_phy, ONLY: ntraciso,niso
    1399113940    USE isotopes_mod, ONLY: tcorr, toce, alpha_liq_sol,ridicule_evap, &
    1399213941        iso_eau,iso_HDO
    … …  
    1405013999
    1405114000#ifdef ISOVERIF
    14052         write(*,*) 'calcul_iso_surf_sic 175: entree'
    14053 #endif 
    14054 #ifdef ISOVERIF
    1405514001        do i=1,knon
    1405614002         do ixt=1,ntraciso
    … …  
    1424714193     &   )
    1424814194
    14249     USE infotrac_phy, ONLY: ntraciso,niso
    1425014195    USE isotopes_mod, ONLY: h_land_ice, ridicule,ridicule_snow,ridicule_evap, &
    1425114196        iso_eau,iso_HDO,iso_O18
    … …  
    1458214527     &   )
    1458314528
    14584 USE infotrac_phy, ONLY: niso,ntraciso
    1458514529USE isotopes_mod, ONLY: tdifrel,tdifexp_sol, iso_eau, iso_HDO, &
    1458614530&       bidouille_anti_divergence,ruissellement_pluie, Rdefault,Kd, &
    … …  
    1471814662
    1471914663#ifdef ISOVERIF   
    14720       write(*,*) 'calcul_iso_surf_ter 494'
     14664!      write(*,*) 'calcul_iso_surf_ter 494'
    1472114665      do i=1,knon         
    1472214666        if (iso_eau.gt.0) then 
    … …  
    1476614710#endif     
    1476714711#ifdef ISOVERIF
    14768         write(*,*) 'calcul_iso_surf_ter 910'
     14712!        write(*,*) 'calcul_iso_surf_ter 910'
    1476914713        do i=1,knon
    1477014714          if (iso_eau.gt.0) then
    … …  
    1601015954      !USE write_field_phy
    1601115955      USE indice_sol_mod, only: nbsrf 
    16012   USE infotrac_phy, ONLY: ntraciso,niso
    1601315956  USE isotopes_mod, ONLY: initialisation_iso, iso_eau,iso_HDO, &
    1601415957        ridicule_qsol,tnat, P_veg,iso_O18,ridicule, ridicule_snow,iso_O17, &
    … …  
    1602515968#include "dimsoil.h"
    1602615969#include "clesphys.h"
    16027 #include "thermcell.h"
    1602815970#include "compbl.h"     
    1602915971
    … …  
    1607216014!      write(*,*) 'xtsnow(4,8,1)=',xtsnow(4,8,1)
    1607316015#ifdef ISOVERIF
    16074       write(*,*) 'phyiso_etat0 15993 tmp: xtsol(iso_eau,1),qsol(1)=',xtsol(iso_eau,1),qsol(1)
    1607516016      do i=1,klon
    1607616017         do ixt=1,niso
    … …  
    1619816139      !USE write_field_phy
    1619916140      USE indice_sol_mod, only: nbsrf
    16200   USE infotrac_phy, ONLY: ntraciso,niso
    1620116141  USE isotopes_mod, ONLY: tnat,iso_HDO,iso_O18,iso_HTO, iso_eau,toce, &
    1620216142&       Rdefault,iso_O17,ridicule,ridicule_qsol
    … …  
    1621116151#include "dimsoil.h"
    1621216152#include "clesphys.h"
    16213 #include "thermcell.h"
     16153!  #include "thermcell.h"
    1621416154#include "compbl.h"
    1621516155
    … …  
    1637716317     &                  *(1-kcin(ixt))/(1.0-kcin(ixt)*h0)
    1637816318           xt_ancien(ixt,i,k)=q_ancien(i,k)*RMerlivat(ixt) &
    16379      &                  *(q_ancien(i,k)/q0)**(alpha(ixt)-1.0)
     16319     &                  *(min(q0,q_ancien(i,k))/q0)**(alpha(ixt)-1.0)
    1638016320           if (q_ancien(i,k).gt.ridicule) then
    1638116321           xtl_ancien(ixt,i,k)=ql_ancien(i,k)*alpha(ixt) &
    … …  
    1647716417
    1647816418#ifdef ISOVERIF
     16419      write(*,*) 'phyisoetat0 16468: verif init dure'
    1647916420      do i=1,klon
    1648016421         do ixt=1,niso
    … …  
    1650816449           if (iso_eau.gt.0) then
    1650916450             call iso_verif_egalite(xt_ancien(iso_eau,i,k), &
    16510      &           q_ancien(i,k),'phyiso_etat0_dur 775')       
     16451     &           q_ancien(i,k),'phyiso_etat0_dur 775a')       
    1651116452           endif !if (iso_eau.gt.0) then
     16453           if (iso_HDO.gt.0) then
     16454             if (q_ancien(i,k).gt.ridicule) then
     16455              call iso_verif_aberrant_encadre( &
     16456     &           xt_ancien(iso_hdo,i,k)/q_ancien(i,k), &
     16457     &          'phyiso_etat0_dur 775b')
     16458             endif !if (q_ancien(i,k).gt.ridicule) then
     16459           endif !if (iso_HDO.gt.0) then
     16460           if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
     16461              if (q_ancien(i,k).gt.ridicule) then
     16462                call iso_verif_O18_aberrant( &
     16463     &              xt_ancien(iso_hdo,i,k)/q_ancien(i,k), &
     16464     &              xt_ancien(iso_O18,i,k)/q_ancien(i,k), &
     16465     &              'phyiso_etat0_dur 775c')
     16466              endif ! if (q_ancien(i,k).gt.ridicule) then
     16467           endif ! if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
    1651216468         enddo !do k=1,klev
    1651316469         do nsrf=1,nbsrf
    … …  
    1655216508      end subroutine phyiso_etat0_dur
    1655316509
    16554       subroutine phyiso_etat0_fichier( &
    16555      &           snow,run_off_lic_0, &
    16556      &           xtsnow,xtrun_off_lic_0, &
    16557      &           Rland_ice)
    16558       USE dimphy, only: klon,klev
    16559       !USE mod_grid_phy_lmdz
    16560       !USE mod_phys_lmdz_para
    16561       USE iophy
    16562       USE phys_state_var_mod, ONLY: q_ancien,xt_ancien,wake_deltaq,wake_deltaxt, &
    16563 #ifdef ISOVERIF
    16564         rain_fall,snow_fall,fevap,qsol, &
    16565 #endif
    16566         xtrain_fall,xtsnow_fall,ql_ancien,xtl_ancien,qs_ancien,xts_ancien, &
    16567         fxtevap,xtsol
    16568       !USE iostart
    16569       !USE write_field_phy
    16570       USE indice_sol_mod, only: nbsrf 
    16571   USE infotrac_phy, ONLY: ntraciso,niso
    16572   USE isotopes_mod, ONLY: striso,iso_HDO,iso_eau
    16573 #ifdef ISOVERIF
    16574   USE isotopes_verif_mod
     16510SUBROUTINE phyiso_etat0_fichier(snow, run_off_lic_0, xtsnow, xtrun_off_lic_0, Rland_ice)
     16511   USE dimphy,             ONLY: klon,klev
     16512   USE iophy
     16513   USE phys_state_var_mod, ONLY: q_ancien, xt_ancien, wake_deltaq, wake_deltaxt, &
     16514#ifdef ISOVERIF
     16515     rain_fall, snow_fall, fevap,qsol, &
     16516#endif
     16517     xtrain_fall, xtsnow_fall, ql_ancien, xtl_ancien, qs_ancien, xts_ancien, fxtevap, xtsol
     16518   USE indice_sol_mod,    ONLY: nbsrf 
     16519   USE isotopes_mod,      ONLY: isoName,iso_HDO,iso_eau
     16520   USE phyetat0_mod,      ONLY: phyetat0_get, phyetat0_srf
     16521   USE readTracFiles_mod, ONLY: new2oldH2O
     16522   USE strings_mod,       ONLY: strIdx, strHead, strTail, maxlen, msg, int2str
     16523#ifdef ISOVERIF
     16524   USE isotopes_verif_mod
    1657516525#endif
    1657616526#ifdef ISOTRAC
    16577  USE isotrac_mod, ONLY: strtrac,initialisation_isotrac,index_iso, &
    16578 &       index_zone,izone_init
    16579 #endif
    16580         implicit none
     16527   USE isotrac_mod, ONLY: strtrac, initialisation_isotrac, index_iso, index_zone, izone_init
     16528#endif
     16529   IMPLICIT NONE
    1658116530
    1658216531#include "netcdf.inc"
    1658316532#include "dimsoil.h"
    1658416533#include "clesphys.h"
    16585 #include "thermcell.h"
    1658616534#include "compbl.h"   
    1658716535
    16588         ! inputs
    16589         !REAL qsol(klon)
    16590         REAL snow(klon,nbsrf)
    16591         !REAL evap(klon,nbsrf)
    16592         REAL run_off_lic_0(klon)
    16593         ! outputs   
    16594         !REAL xtsol(niso,klon)
    16595         REAL xtsnow(niso,klon,nbsrf)
    16596         !REAL xtevap(ntraciso,klon,nbsrf)     
    16597         REAL xtrun_off_lic_0(niso,klon)
    16598         REAL Rland_ice(niso,klon)
    16599 
    16600         ! locals
    16601         real iso_tmp(klon)
    16602         real iso_tmp_lonlev(klon,klev)
    16603         real iso_tmp_lonsrf(klon,nbsrf)
    16604         INTEGER ierr
    16605         integer i,ixt,k,nsrf
    16606         INTEGER nid, nvarid
    16607         CHARACTER*2 str2
    16608         CHARACTER*5 str5
    16609         real xmin,xmax   
    16610         CHARACTER*50 striso_sortie 
    16611         integer lnblnk
    16612         LOGICAL :: found,phyetat0_get,phyetat0_srf
    16613 
    16614 !#ifdef ISOVERIF
    16615 !      integer iso_verif_egalite_nostop
    16616 !#endif
    16617 !#ifdef ISOVERIF
    16618 !        real deltaD
    16619 !        integer iso_verif_noNaN_nostop
    16620 !#endif
     16536   REAL, INTENT(IN) ::             snow     (klon,nbsrf)
     16537   REAL, INTENT(IN) ::    run_off_lic_0     (klon)
     16538   REAL, INTENT(OUT) ::          xtsnow(niso,klon,nbsrf)
     16539   REAL, INTENT(OUT) :: xtrun_off_lic_0(niso,klon)
     16540   REAL, INTENT(OUT) ::       Rland_ice(niso,klon)
     16541
     16542   INTEGER :: ierr, i, ixt, k, nsrf, nid, nvarid, lnblnk
     16543   CHARACTER(LEN=2) :: str2
     16544   CHARACTER(LEN=5) :: str5
     16545   CHARACTER(LEN=maxlen) :: outiso, oldIso, modname, nam(2)
     16546   REAL :: xmin, xmax
     16547   LOGICAL :: found
    1662116548#ifdef ISOTRAC
    16622         integer iiso,izone
    16623 #endif
    16624 
    16625 
    16626    write(*,*) 'phyiso_etat0_fichier 3'
    16627    write(*,*) 'niso=',niso
    16628    write(*,*) 'striso(1)=',striso(1)
    16629 
    16630    do ixt=1,ntraciso
    16631 
    16632      if (ixt.le.niso) then
    16633         striso_sortie=striso(ixt)
    16634      else
     16549   INTEGER :: iiso, izone
     16550#endif
     16551
     16552   modname = 'phyiso_etat0_fichier'
     16553   CALL msg('3', modname)
     16554   CALL msg('niso = '//TRIM(int2str(niso)), modname)
     16555   CALL msg('isoName(1) = '//TRIM(isoName(1)), modname)
     16556
     16557   DO ixt = 1, ntraciso
     16558
     16559      outiso = isoName(ixt)
     16560      oldIso = strTail(new2oldH2O(outiso), '_', lFirst=.TRUE.)
     16561      ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après fichier:
    1663516562#ifdef ISOTRAC
    16636         iiso=index_iso(ixt)
    16637         izone=index_zone(ixt)       
    16638         striso_sortie=striso(iiso)//strtrac(izone)
    16639 #else
    16640         write(*,*) 'phyredem 546: ixt,ntraciso=', ixt,ntraciso
    16641         stop
    16642 #endif
    16643      endif !if (ixt.le.niso) then
    16644      write(*,*) 'phyiso_etat0_fichier 16621: ixt,striso_sortie=',ixt,striso_sortie(1:lnblnk(striso_sortie))
    16645 
    16646            
    16647       ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après
    16648       ! fichier:
     16563      IF(ixt <= niso .OR. initialisation_isotrac == 0) THEN
     16564#endif
     16565      found = phyetat0iso_srf3(xtsnow,      "XTSNOW", "Surface snow", 0.)
     16566      if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581: unfound isotopic variable',1)
     16567      found = phyetat0iso_srf3(fxtevap,     "XTEVAP", "evaporation",  0.)
     16568      found = phyetat0iso_get2(xtrain_fall, "xtrain_f", "xrain fall", 0.)
     16569      found = phyetat0iso_get2(xtrain_fall, "xtsnow_f", "xsnow fall", 0.)
     16570      found = phyetat0iso_get3(xt_ancien,   "XTANCIEN",  "QANCIEN",   0.)
     16571      found = phyetat0iso_get3(xtl_ancien,  "XTLANCIEN", "QLANCIEN",  0.)
     16572      found = phyetat0iso_get3(xts_ancien,  "XTASNCIEN", "QSANCIEN",  0.)
     16573      found = phyetat0iso_get2(xtrun_off_lic_0, "XTRUNOFFLIC0", "RUNOFFLIC0", 0.)
     16574      found = phyetat0iso_get3(wake_deltaxt,  "WAKE_DELTAXT", "Delta hum. wake/env",  0.)
     16575#ifdef ISOVERIF
     16576      IF(ixt == iso_eau .AND. iso_eau > 0) THEN
     16577         DO i=1,klon
     16578            CALL iso_verif_egalite(xtrain_fall(iso_eau,i),rain_fall(i),TRIM(modname)//' 231a')
     16579            CALL iso_verif_egalite(xtsnow_fall(iso_eau,i),snow_fall(i),TRIM(modname)//' 231b')
     16580            DO nsrf = 1, nbsrf
     16581               CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf),TRIM(modname)//' 231c')
     16582               CALL iso_verif_egalite( xtsnow(iso_eau,i,nsrf), snow(i,nsrf),TRIM(modname)//' 231d')
     16583            END DO
     16584         END DO
     16585      END IF
     16586      IF(ixt == iso_HDO .AND. iso_HDO > 0) THEN
     16587         DO k=1,klev
     16588            DO i=1,klon
     16589               IF(q_ancien(i,k) > 2e-3) &
     16590                  CALL iso_verif_aberrant(xt_ancien(iso_hdo,i,k)/q_ancien(i,k),TRIM(modname)//' 312')
     16591            END DO
     16592         END DO
     16593      END IF
     16594      IF(iso_eau > 0 .AND. ixt == iso_eau) THEN
     16595         DO i=1,klon
     16596            IF(iso_verif_egalite_nostop(run_off_lic_0(i),xtrun_off_lic_0(iso_eau,i),TRIM(modname)//' 326') == 1) THEN
     16597               WRITE(*,*) 'i=',i
     16598               STOP
     16599            END IF
     16600         END DO
     16601      END IF
     16602#endif
     16603      ! ces variables n'ont pas de traceurs:
     16604      IF(ixt <= niso) THEN
     16605         found = phyetat0iso_get2(xtsol, "XTSOL", "Surface humidity / bucket", 0.)
     16606         found = phyetat0iso_get2(Rland_ice, "Rland_ice", "SR land ice", 0.)
     16607#ifdef ISOVERIF
     16608
     16609         DO i=1,klon
     16610            IF(iso_verif_noNaN_nostop(xtsol(ixt,i),TRIM(modname)//' 95') == 1) THEN
     16611               WRITE(*,*) 'ixt,i=',ixt,i
     16612               STOP
     16613            END IF
     16614         END DO
     16615#endif
     16616      END IF
    1664916617#ifdef ISOTRAC
    16650       if ((ixt.le.niso).or.(initialisation_isotrac.eq.0)) then
    16651 #endif
    16652 
    16653       found=phyetat0_srf(1,iso_tmp_lonsrf,"XTSNOW"//striso_sortie(1:lnblnk(striso_sortie)), &
    16654      &     "Surface snow",0.)
    16655       if (.NOT.found) then
    16656         CALL abort_physic('isotopes_routines_mod', &
    16657                 'phyiso_etat0_fichier 16581: variable isotopique not found',1)
    16658       endif
    16659       xtsnow(ixt,:,:)=iso_tmp_lonsrf(:,:)
    16660      
    16661       found=phyetat0_srf(1,iso_tmp_lonsrf,"XTEVAP"//striso_sortie &
    16662      &   (1:lnblnk(striso_sortie)),"evaporation",0.)
    16663       fxtevap(ixt,:,:)=iso_tmp_lonsrf(:,:)
    16664 
    16665       found=phyetat0_get(1,iso_tmp,"xtrain_f"//striso_sortie &
    16666      &   (1:lnblnk(striso_sortie)),"xrain fall",0.)
    16667       xtrain_fall(ixt,:)=iso_tmp(:)
    16668 
    16669       found=phyetat0_get(1,iso_tmp,"xtsnow_f"//striso_sortie &
    16670      &   (1:lnblnk(striso_sortie)),"snow fall",0.)
    16671       xtsnow_fall(ixt,:)=iso_tmp(:)
    16672 
    16673       found=phyetat0_get(klev,iso_tmp_lonlev,"XTANCIEN"//striso_sortie &
    16674      &       (1:lnblnk(striso_sortie)),"QANCIEN",0.)
    16675       xt_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    16676 
    16677       found=phyetat0_get(klev,iso_tmp_lonlev,"XTLANCIEN"//striso_sortie &
    16678      &       (1:lnblnk(striso_sortie)),"QLANCIEN",0.)
    16679       xtl_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    16680 
    16681       found=phyetat0_get(klev,iso_tmp_lonlev,"XTSANCIEN"//striso_sortie &
    16682      &       (1:lnblnk(striso_sortie)),"QSANCIEN",0.)
    16683       xts_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    16684 
    16685 
    16686       found=phyetat0_get(1,iso_tmp,"XTRUNOFFLIC0"//striso_sortie(1:lnblnk(striso_sortie)), &
    16687      &          "RUNOFFLIC0",0.) 
    16688       xtrun_off_lic_0(ixt,:)=iso_tmp(:)
    16689 
    16690 
    16691       found=phyetat0_get(klev,iso_tmp_lonlev,"WAKE_DELTAXT"//striso_sortie &
    16692      &   (1:lnblnk(striso_sortie)),"Delta hum. wake/env",0.) 
    16693       wake_deltaxt(ixt,:,:)=iso_tmp_lonlev(:,:)
    16694 
    16695 #ifdef ISOVERIF           
    16696       if ((ixt.eq.iso_eau).and.(iso_eau.gt.0)) then
    16697         do i=1,klon
    16698          call iso_verif_egalite(xtrain_fall(iso_eau,i),rain_fall(i), &
    16699      &           'phyisoetat0_fichier 231a')
    16700          call iso_verif_egalite(xtsnow_fall(iso_eau,i),snow_fall(i), &
    16701      &           'phyisoetat0_fichier 231b')
    16702          DO nsrf = 1, nbsrf
    16703          call iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf), &
    16704      &           'phyisoetat0_fichier 231c')
    16705          call iso_verif_egalite(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
    16706      &           'phyisoetat0_fichier 231d')
    16707          enddo !DO nsrf = 1, nbsrf
    16708         enddo !do i=1,klon       
    16709       endif !if (iso_eau.gt.0) then 
    16710         if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
    16711               do k=1,klev
    16712                do i=1,klon
    16713                 if (q_ancien(i,k).gt.2e-3) then
    16714                 call iso_verif_aberrant(xt_ancien(iso_hdo,i,k) &
    16715      &           /q_ancien(i,k),'phyisoetat0_fichier 312')
    16716                 endif !if (q_ancien(i,k).gt.2e-3) then
    16717                enddo !do i=1,klon
    16718               enddo !do k=1,klev
    16719       endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
    16720       if (iso_eau.gt.0) then   
    16721         do i=1,klon
    16722           if (iso_verif_egalite_nostop(run_off_lic_0(i), &
    16723      &           xtrun_off_lic_0(iso_eau,i), &
    16724      &          'phyiso_etat0_fichier 326').eq.1) then
    16725             write(*,*) 'i=',i
    16726             stop
    16727           endif !if (iso_verif_egalite_nostop(run_off_lic_0(i),
    16728         enddo !do i=1,klon
    16729       endif !if (iso_eau.gt.0) then
    16730 #endif
    16731 
    16732        ! ces variables n'ont pas de traceurs:
    16733        if (ixt.le.niso) then
    16734         found=phyetat0_get(1,iso_tmp,"XTSOL"//striso_sortie(1:lnblnk(striso_sortie)), &
    16735      &     "Surface hmidity / bucket",0.) 
    16736         xtsol(ixt,:)=iso_tmp(:)
    16737 
    16738         found=phyetat0_get(1,iso_tmp,"Rland_ice"//striso_sortie &
    16739      &     (1:lnblnk(striso_sortie)),"R land ice",0.)
    16740         Rland_ice(ixt,:)=iso_tmp(:)
    16741 
    16742 #ifdef ISOVERIF
    16743       do i=1,klon
    16744           if (iso_verif_noNaN_nostop(xtsol(ixt,i), &
    16745      &          'phyiso_etat0_fichier 95').eq.1) then
    16746             write(*,*) 'ixt,i=',ixt,i
    16747             stop
    16748           endif       
    16749       enddo !do i=1,klon
    16750 #endif
    16751 
    16752        endif
     16618      END IF ! IF(ixt > niso .OR. initialisation_isotrac == 0))
     16619#endif
     16620
     16621   END DO
    1675316622
    1675416623#ifdef ISOTRAC
    16755      endif !if ((ixt.le.niso).or.(initialisation_isotrac.eq.0)) then
    16756 #endif
    16757 
    16758   enddo !do ixt=1,ntraciso
    16759 
    16760 #ifdef ISOTRAC
    16761         if (initialisation_isotrac.ne.0) then
    16762         ! on n'initialise pas d'après le fichier
    16763         ! l'eau normale est mise dans la zone izone_init
    16764 
    16765         do ixt=niso+1,ntraciso
    16766 
    16767              iiso=index_iso(ixt)
    16768 
    16769              if (index_zone(ixt).eq.izone_init) then
    16770                 do i=1,klon
    16771                  do nsrf = 1, nbsrf
    16772                   fxtevap(ixt,i,nsrf)=fxtevap(iiso,i,nsrf)
    16773                  enddo !do nsrf = 1, nbsrf
    16774                  xtsnow_fall(ixt,i)=xtsnow_fall(iiso,i)
    16775                  xtrain_fall(ixt,i)=xtrain_fall(iiso,i)
    16776                  do k=1,klev
    16777                    xt_ancien(ixt,i,k)=xt_ancien(iiso,i,k)
    16778                    xtl_ancien(ixt,i,k)=xtl_ancien(iiso,i,k)
    16779                    xts_ancien(ixt,i,k)=xts_ancien(iiso,i,k)
    16780                    wake_deltaxt(ixt,i,k)= wake_deltaxt(iiso,i,k)   
    16781                  enddo
    16782                 enddo !do i=1,klon
    16783              else !if (index_zone(ixt).eq.izone_init) then
    16784                 do i=1,klon
    16785                  do nsrf = 1, nbsrf
    16786                   fxtevap(ixt,i,nsrf)=0.0
    16787                  enddo !do nsrf = 1, nbsrf
    16788                  xtsnow_fall(ixt,i)=0.0
    16789                  xtrain_fall(ixt,i)=0.0
    16790                  do k=1,klev
    16791                    xt_ancien(ixt,i,k)=0.0
    16792                    xtl_ancien(ixt,i,k)=0.0
    16793                    xts_ancien(ixt,i,k)=0.0
    16794                  enddo
    16795                 enddo !do i=1,klon
    16796              endif !if (index_zone(ixt).eq.izone_init) then
    16797 
    16798          enddo  !do ixt=1,niso
    16799       endif !if (initialisation_isotrac.eq.0) then
    16800 
    16801 
    16802 #ifdef ISOVERIF
    16803         DO nsrf = 1, nbsrf
    16804          do i=1,klon
    16805                call iso_verif_traceur(fxtevap(1,i,nsrf), &
    16806      &                   'phyiso_etat0_fichier 426')
    16807          enddo !do i=1,klon
    16808         enddo !DO nsrf = 1, nbsrf
    16809         do i=1,klon
    16810            call iso_verif_traceur(xtrain_fall(1,i), &
    16811      &                   'phyiso_etat0_fichier 466')
    16812            call iso_verif_traceur(xtsnow_fall(1,i), &
    16813      &                   'phyiso_etat0_fichier 468')
    16814         enddo !do i=1,klon
    16815         do k=1,klev
    16816           do i=1,klon
    16817                call iso_verif_traceur(xt_ancien(1,i,k), &
    16818      &                   'phyiso_etat0_fichier 591')
    16819           enddo !do i=1,klon
    16820         enddo !do k=1,klev             
     16624   IF(initialisation_isotrac /= 0) THEN
     16625      ! On n'initialise pas d'apres le fichier. L'eau normale est mise dans la zone izone_init
     16626      DO ixt=niso+1,ntraciso
     16627         iiso=index_iso(ixt)
     16628         IF(index_zone(ixt) == izone_init) THEN
     16629            DO i = 1, klon
     16630               fxtevap(ixt,i,1:nsrf) = fxtevap(iiso,i,1:nsrf)
     16631               xtsnow_fall(ixt,i) = xtsnow_fall(iiso,i)
     16632               xtrain_fall(ixt,i) = xtrain_fall(iiso,i)
     16633               DO k = 1, klev
     16634                  xt_ancien   (ixt,i,k) = xt_ancien   (iiso,i,k)
     16635                  xtl_ancien  (ixt,i,k) = xtl_ancien  (iiso,i,k)
     16636                  xts_ancien  (ixt,i,k) = xts_ancien  (iiso,i,k)
     16637                  wake_deltaxt(ixt,i,k) = wake_deltaxt(iiso,i,k)   
     16638               END DO
     16639            END DO
     16640         ELSE
     16641            DO i = 1, klon
     16642               fxtevap(ixt,i,1:nbsrf)=0.0
     16643               xtsnow_fall(ixt,i)=0.0
     16644               xtrain_fall(ixt,i)=0.0
     16645               xt_ancien (ixt,i,1:klev) = 0.0
     16646               xtl_ancien(ixt,i,1:klev) = 0.0
     16647               xts_ancien(ixt,i,1:klev) = 0.0
     16648            END DO
     16649         END IF
     16650      END DO
     16651   END IF
     16652
     16653#ifdef ISOVERIF
     16654   DO nsrf = 1, nbsrf
     16655      DO i = 1, klon
     16656         CALL iso_verif_traceur(fxtevap(1,i,nsrf), 'phyiso_etat0_fichier 426')
     16657      END DO
     16658   END DO
     16659   DO i=1,klon
     16660      CALL iso_verif_traceur(xtrain_fall(1,i), 'phyiso_etat0_fichier 466')
     16661      CALL iso_verif_traceur(xtsnow_fall(1,i), 'phyiso_etat0_fichier 468')
     16662   END DO
     16663   DO k = 1, klev
     16664      DO i = 1, klon
     16665         CALL iso_verif_traceur(xt_ancien(1,i,k), 'phyiso_etat0_fichier 591')
     16666      END DO
     16667   END DO
    1682116668#endif
    1682216669        ! endif ISOVERIF       
    … …  
    1682416671        ! endif ISOTRAC     
    1682516672
    16826 ! on ferme le fichier
    16827 !      CALL close_startphy
    16828 ! déjà fermé dans phyetat0
     16673CONTAINS
     16674
     16675LOGICAL FUNCTION phyetat0iso_get2(field, pref, descr, default) RESULT(lFound)
     16676  REAL,             INTENT(INOUT) :: field(:,:)
     16677  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
     16678  REAL,             INTENT(IN)    :: default
     16679  REAL :: iso_tmp(klon)
     16680  nam(1) = TRIM(pref)//TRIM(outiso)
     16681  nam(2) = TRIM(pref)//TRIM(oldIso)
     16682  lFound = phyetat0_get(iso_tmp, nam, descr, default)
     16683  field(ixt,:) = iso_tmp
     16684END FUNCTION phyetat0iso_get2
     16685
     16686
     16687LOGICAL FUNCTION phyetat0iso_get3(field, pref, descr, default) RESULT(lFound)
     16688  REAL,             INTENT(INOUT) :: field(:,:,:)
     16689  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
     16690  REAL,             INTENT(IN)    :: default
     16691  REAL :: iso_tmp_lonlev(klon,klev)
     16692  nam(1) = TRIM(pref)//TRIM(outiso)
     16693  nam(2) = TRIM(pref)//TRIM(oldIso)
     16694  lFound = phyetat0_get(iso_tmp_lonlev, nam, descr, default)
     16695  field(ixt,:,:) = iso_tmp_lonlev(:,:)
     16696END FUNCTION phyetat0iso_get3
     16697
     16698LOGICAL FUNCTION phyetat0iso_srf3(field, pref, descr, default) RESULT(lFound)
     16699  REAL,             INTENT(INOUT) :: field(:,:,:)
     16700  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
     16701  REAL,             INTENT(IN)    :: default
     16702  REAL :: iso_tmp_lonsrf(klon,nbsrf)
     16703  nam(1) = TRIM(pref)//TRIM(outiso)
     16704  nam(2) = TRIM(pref)//TRIM(oldIso)
     16705  lFound = phyetat0_srf(iso_tmp_lonsrf, nam, descr, default)
     16706  field(ixt,:,:) = iso_tmp_lonsrf
     16707END FUNCTION phyetat0iso_srf3
    1682916708
    1683016709        end subroutine phyiso_etat0_fichier
     16710
     16711
    1683116712
    1683216713
    … …  
    1684416725     &           d_xt_decroiss, &
    1684516726     &           xt_seri)
    16846         USE infotrac_phy, only: ntraciso
    1684716727        USE isotopes_mod, only: iso_HTO,ok_prod_nucl_tritium
    1684816728        USE dimphy, only: klon,klev
    … …  
    1836618246!     &                         prod_nucl_HTO)
    1836718247
    18368         USE infotrac_phy, only: ntraciso
    1836918248        use isotopes_mod, only: nessai, lat_nucl, lon_nucl, &
    1837018249&               zmin_nucl, zmax_nucl, HTO_nucl
    … …  
    1858818467     &                                paprs, &
    1858918468     &                                prod_nucl)
    18590         USE infotrac_phy, only: ntraciso
    1859118469        USE isotopes_mod, ONLY: iso_HTO
    1859218470        use geometry_mod, only: cell_area
    … …  
    1873418612     &           tcond,zfice,zxtice,zxtliq)
    1873518613
    18736     USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
    1873718614    USE isotopes_mod, ONLY: iso_eau,iso_HDO,essai_convergence, &
    1873818615&       bidouille_anti_divergence,ridicule
    … …  
    1886418741     &           tcond,zfice,zxtice,zxtliq,n)
    1886518742
    18866     USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
    1886718743    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,bidouille_anti_divergence, &
    1886818744&       ridicule

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/isotopes_verif_mod.F90

    r3927 r4368  
    66!use isotopes_mod, ONLY:
    77!#ifdef ISOTRAC
    8 !use isotrac_mod, ONLY:
     8!   USE isotrac_mod, ONLY: nzone
    99!#endif
     10USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, itZonIso, nzone
    1011implicit none
    1112save
    … …  
    9394        SUBROUTINE iso_verif_init()
    9495        use ioipsl_getin_p_mod, ONLY : getin_p
    95         !USE infotrac_phy, ONLY: use_iso
    9696        use isotopes_mod, ONLY: iso_O17, iso_O18, iso_HDO
    9797        implicit none
    … …  
    196196
    197197        subroutine iso_verif_aberrant(R,err_msg)
    198         !USE infotrac_phy, ONLY: use_iso
    199198        use isotopes_mod, ONLY: ridicule, iso_HDO
    200199        implicit none
    … …  
    227226
    228227        subroutine iso_verif_aberrant_encadre(R,err_msg)
    229         !use infotrac_phy, ONLY: use_iso
    230228        use isotopes_mod, ONLY: ridicule, iso_HDO
    231229        implicit none
    … …  
    263261
    264262        subroutine iso_verif_aberrant_choix(xt,q,qmin,deltaDmax,err_msg)
    265         !use infotrac_phy, ONLY: use_iso
    266263        use isotopes_mod, ONLY: iso_HDO
    267264        implicit none
    … …  
    298295
    299296        function iso_verif_aberrant_nostop(R,err_msg)
    300         !use infotrac_phy, ONLY: use_iso
    301297        use isotopes_mod, ONLY: ridicule,iso_HDO
    302298        implicit none
    … …  
    330326
    331327        function iso_verif_aberrant_enc_nostop(R,err_msg)
    332         !use infotrac_phy, ONLY: use_iso
    333328        use isotopes_mod, ONLY: ridicule,iso_HDO
    334329        implicit none
    … …  
    366361     &            qmin,deltaDmax,err_msg)
    367362
    368         !use infotrac_phy, ONLY: use_iso
    369363        use isotopes_mod, ONLY: iso_HDO
    370364        implicit none
    … …  
    428422        function iso_verif_aberrant_enc_choix_nostop(xt,q,   &
    429423     &            qmin,deltaDmax,err_msg)
    430         !use infotrac_phy, ONLY: use_iso
    431424        use isotopes_mod, ONLY: iso_HDO
    432425        implicit none
    … …  
    528521            write(*,*) 'o17excess=',o17excess(R17,R18)
    529522            write(*,*) 'deltaO17=',(R17/tnat(iso_o17)-1.0)*1000.0
    530             write(*,*) 'deltaO18=',(R18/tnat(iso_o18)-1.0)*1000.0
     523            write(*,*) 'deltaO18=',(R18/tnat(iso_O18)-1.0)*1000.0
    531524            ! attention, vérifier que la ligne suivante est bien activée
    532525            iso_verif_aberrant_o17_nostop=1
    … …  
    998991
    999992       
    1000         subroutine iso_verif_o18_aberrant(Rd,Ro,err_msg)
     993        subroutine iso_verif_O18_aberrant(Rd,Ro,err_msg)
    1001994        implicit none
    1002995
    … …  
    10091002
    10101003        ! local
    1011         !integer iso_verif_o18_aberrant_nostop
    1012 
    1013         if (iso_verif_o18_aberrant_nostop(Rd,Ro,err_msg).eq.1) then
     1004        !integer iso_verif_O18_aberrant_nostop
     1005
     1006        if (iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg).eq.1) then
    10141007            stop
    10151008        endif
    10161009
    1017         end subroutine iso_verif_o18_aberrant
    1018        
    1019         function iso_verif_o18_aberrant_nostop(Rd,Ro,err_msg)
     1010        end subroutine iso_verif_O18_aberrant
     1011       
     1012        function iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg)
    10201013        USE isotopes_mod, ONLY: tnat, iso_HDO, iso_O18
    10211014        implicit none
    … …  
    10301023
    10311024        ! outputs
    1032         integer iso_verif_o18_aberrant_nostop
     1025        integer iso_verif_O18_aberrant_nostop
    10331026
    10341027        !locals
    … …  
    10391032        dexcess=deltaD-8*deltao
    10401033
    1041         iso_verif_o18_aberrant_nostop=0
     1034        iso_verif_O18_aberrant_nostop=0
    10421035        if ((deltaD.lt.deltaDmin).or.(deltao.lt.deltaDmin/2.0).or. &
    10431036     &        (deltaD.gt.deltalim).or.(deltao.gt.deltalim/8.0).or. &
    10441037     &        ((deltaD.gt.-500.0).and.((dexcess.lt.dexcess_min) &
    10451038     &        .or.(dexcess.gt.dexcess_max)))) then
    1046             write(*,*) 'erreur detectee par iso_verif_o18_aberrant:'
     1039            write(*,*) 'erreur detectee par iso_verif_O18_aberrant:'
    10471040            write(*,*) err_msg
    10481041            write(*,*) 'delta180=',deltao
    … …  
    10501043            write(*,*) 'Dexcess=',dexcess
    10511044!            stop
    1052             iso_verif_o18_aberrant_nostop=1
     1045            iso_verif_O18_aberrant_nostop=1
    10531046          endif
    10541047
    … …  
    10601053
    10611054        return
    1062         end function iso_verif_o18_aberrant_nostop
     1055        end function iso_verif_O18_aberrant_nostop
    10631056
    10641057
    10651058        ! **********
    10661059        function deltaD(R)
    1067         !use infotrac_phy, ONLY: use_iso
    10681060        USE isotopes_mod, ONLY: tnat,iso_HDO
    10691061        implicit none
    … …  
    10821074        ! **********
    10831075        function deltaO(R)
    1084         !use infotrac_phy, ONLY: use_iso
    10851076        USE isotopes_mod, ONLY: tnat,iso_O18
    10861077        implicit none
    … …  
    10981089        ! **********
    10991090        function dexcess(RD,RO)
    1100         !use infotrac_phy, ONLY: use_iso
    11011091        USE isotopes_mod, ONLY: tnat,iso_O18,iso_HDO
    11021092        implicit none
    … …  
    11381128         ! **********
    11391129        function o17excess(R17,R18)
    1140         !use infotrac_phy, ONLY: use_iso
    11411130        USE isotopes_mod, ONLY: tnat,iso_O18,iso_O17
    11421131        implicit none
    … …  
    11461135           
    11471136           o17excess=1e6*(log(R17/tnat(iso_o17)) &
    1148      &           -0.528*log(R18/tnat(iso_o18)))
     1137     &           -0.528*log(R18/tnat(iso_O18)))
    11491138!           write(*,*) 'o17excess=',o17excess
    11501139        else
    … …  
    11601149     &           xt,q,err_msg,ni,n,m)
    11611150       
    1162         !use infotrac_phy, ONLY: use_iso
    11631151        USE isotopes_mod, ONLY: iso_eau
    11641152          implicit none
    … …  
    12121200     &           xt,q,err_msg,ni,n)
    12131201
    1214         !use infotrac_phy, ONLY: use_iso
    12151202        USE isotopes_mod, ONLY: iso_eau
    12161203        implicit none
    … …  
    12961283        subroutine iso_verif_aberrant_vect2D( &
    12971284     &           xt,q,err_msg,ni,n,m)
    1298         !use infotrac_phy, ONLY: use_iso
    12991285        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    13001286          implicit none
    … …  
    13451331     &           xt,q,err_msg,ni,n,m)
    13461332
    1347         !use infotrac_phy, ONLY: use_iso
    13481333        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    13491334          implicit none
    … …  
    13991384     &           xt,q,err_msg,ni,n,m)
    14001385
    1401         !use infotrac_phy, ONLY: use_iso
    14021386        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    14031387          implicit none
    … …  
    14501434     &           xt,q,err_msg,ni,n,m,deltaDmax)
    14511435
    1452         !use infotrac_phy, ONLY: use_iso
    14531436        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    14541437          implicit none
    … …  
    14981481        end subroutine iso_verif_aberrant_vect2Dch     
    14991482
    1500         subroutine iso_verif_o18_aberrant_enc_vect2D( &
     1483        subroutine iso_verif_O18_aberrant_enc_vect2D( &
    15011484     &           xt,q,err_msg,ni,n,m)
    15021485
    1503         !use infotrac_phy, ONLY: use_iso
    15041486        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
    15051487          implicit none
    … …  
    15501532        endif !if (iso_HDO.gt.0) then
    15511533
    1552         end subroutine iso_verif_o18_aberrant_enc_vect2D   
     1534        end subroutine iso_verif_O18_aberrant_enc_vect2D   
    15531535
    15541536
    … …  
    17661748     &           xt,q,err_msg,ni,n,m,ib,ie)
    17671749
    1768         !use infotrac_phy, ONLY: use_iso
    17691750        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    17701751          implicit none
    … …  
    18171798     &           xt,q,err_msg,ni,n,m,ib,ie)
    18181799       
    1819         !use infotrac_phy, ONLY: use_iso
    18201800        USE isotopes_mod, ONLY: iso_eau
    18211801          implicit none
    … …  
    18631843      function iso_verif_traceur_choix_nostop(x,err_msg, &
    18641844     &       errmax,errmaxrel,ridicule_trac,deltalimtrac)
    1865         USE infotrac_phy, ONLY: ntraciso
    18661845        use isotopes_mod, ONLY: iso_HDO
    18671846        implicit none
    … …  
    19151894        function iso_verif_tracnps_choix_nostop(x,err_msg, &
    19161895     &       errmax,errmaxrel,ridicule_trac,deltalimtrac)
    1917         USE infotrac_phy, ONLY: ntraciso
    19181896        USE isotopes_mod, ONLY: iso_HDO
    19191897        implicit none
    … …  
    19611939
    19621940        function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
    1963         use infotrac_phy, ONLY: ntraciso,niso
    1964         use isotrac_mod, only: index_iso,strtrac,index_zone
    1965         use isotopes_mod, only: striso
     1941        use isotopes_mod, only: isoName
    19661942        implicit none
    19671943
    … …  
    19821958
    19831959       do ixt=niso+1,ntraciso
    1984           iiso=index_iso(ixt)
    19851960          if (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
    1986      &           ', verif positif, iso'//striso(iiso) &
    1987      &           //strtrac(index_zone(ixt))).eq.1) then
     1961     &           ', verif positif, iso'//TRIM(isoName(ixt))).eq.1) then
    19881962            iso_verif_tracpos_choix_nostop=1
    19891963          endif
    … …  
    19941968
    19951969        function iso_verif_traceur_noNaN_nostop(x,err_msg)
    1996         use infotrac_phy, ONLY: ntraciso,niso
    1997         use isotrac_mod, only: index_iso
    1998         use isotopes_mod, only: striso
     1970        use isotopes_mod, only: isoName
    19991971        implicit none
    20001972
    … …  
    20151987
    20161988        do ixt=niso+1,ntraciso
    2017           iiso=index_iso(ixt)
    20181989!          write(*,*) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
    20191990          if (iso_verif_noNaN_nostop(x(ixt),err_msg// &
    2020      &           ', verif trac no NaN, iso'//striso(iiso)) &
     1991     &           ', verif trac no NaN, iso'//TRIM(isoName(ixt))) &
    20211992     &           .eq.1) then
    20221993            iso_verif_traceur_noNaN_nostop=1
    … …  
    20292000     &           errmaxin,errmaxrelin)
    20302001
    2031         use infotrac_phy, ONLY: index_trac,ntraciso,niso
    2032         use isotopes_mod, ONLY: ridicule,striso
    2033         use isotrac_mod, only: ntraceurs_zone
     2002        use isotopes_mod, ONLY: ridicule,isoName
    20342003        ! on vérifie juste bilan de masse
    20352004        implicit none
    … …  
    20532022
    20542023          xtractot=0.0
    2055           do izone=1,ntraceurs_zone 
    2056             ixt=index_trac(izone,iiso)
     2024          do izone=1,nzone 
     2025            ixt=itZonIso(izone,iiso)
    20572026            xtractot=xtractot+x(ixt)
    2058           enddo !do izone=1,ntraceurs_zone
     2027          enddo
    20592028
    20602029          if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
    2061      &        err_msg//', verif trac egalite, iso '//striso(iiso), &
     2030     &        err_msg//', verif trac egalite, iso '// &
     2031     &        TRIM(isoName(iiso)), &
    20622032     &        errmaxin,errmaxrelin).eq.1) then
    20632033            write(*,*) 'iso_verif_traceur 202: x=',x
    … …  
    20702040     &           (abs(x(iiso)).gt.ridicule)) then
    20712041            write(*,*) err_msg,', verif masse traceurs, iso ', &
    2072      &          striso(iiso)
     2042     &          TRIM(isoName(iiso))
    20732043            write(*,*) 'iso_verif_traceur 209: x=',x
    20742044!            iso_verif_tracm_choix_nostop=1
    … …  
    20822052     &           ridicule_trac,deltalimtrac)
    20832053
    2084         use infotrac_phy, ONLY: index_trac,ntraciso
    20852054        USE isotopes_mod, ONLY: iso_eau, iso_HDO
    2086         use isotrac_mod, only: strtrac,ntraceurs_zone
     2055        use isotrac_mod, only: strtrac
    20872056        ! on vérifie juste deltaD
    20882057        implicit none
    … …  
    21032072
    21042073        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
    2105         do izone=1,ntraceurs_zone
    2106              ieau=index_trac(izone,iso_eau)
    2107              ixt=index_trac(izone,iso_HDO)
     2074        do izone=1,nzone
     2075             ieau=itZonIso(izone,iso_eau)
     2076             ixt=itZonIso(izone,iso_HDO)
    21082077
    21092078             if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
    … …  
    21182087!     :           //strtrac(izone))
    21192088!             endif
    2120         enddo !do izone=1,ntraceurs_zone
     2089        enddo !do izone=1,nzone
    21212090       endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
    21222091
    21232092       end function iso_verif_tracdD_choix_nostop
    21242093
    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
     2094INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
     2095  USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
     2096  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
     2097  IMPLICIT NONE
     2098  REAL,             INTENT(IN) :: x(ntraciso)
     2099  CHARACTER(LEN=*), INTENT(IN) :: err_msg
     2100  INTEGER :: ieau, ixt, ieau1
     2101  res = 0
     2102  IF(ALL([17,18]/=option_traceurs)) RETURN
     2103  !--- Check whether * deltaD(highest tagging layer) < 200 permil
     2104  !                  * q <
     2105  ieau=itZonIso(nzone_temp,iso_eau)
     2106  ixt=itZonIso(nzone_temp,iso_HDO)
     2107  IF(x(ieau)>ridicule) THEN
     2108    IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
     2109      res=1; write(*,*) 'x=',x
     2110    END IF
     2111  END IF
     2112  IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
     2113    res=1; write(*,*) 'x=',x
     2114  END IF
     2115  !--- Check whether q is small ; then, qt01 < 10%
     2116  IF(x(iso_eau)<2.0e-3) THEN
     2117    ieau1= itZonIso(1,iso_eau)
     2118    IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
     2119      res=1; write(*,*) 'x=',x
     2120    END IF
     2121  END IF
     2122END FUNCTION iso_verif_tag17_q_deltaD_chns
     2123
     2124SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
     2125  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
     2126  IMPLICIT NONE
     2127  REAL,             INTENT(IN) :: x(ntraciso)
     2128  CHARACTER(LEN=*), INTENT(IN) :: err_msg
     2129  IF(ALL([17,18]/=option_traceurs)) RETURN
     2130  IF(nzone_temp>=5) THEN
     2131    IF(iso_verif_tag17_q_deltaD_chns(x,err_msg)==1) STOP
     2132  END IF
     2133END SUBROUTINE iso_verif_trac17_q_deltaD
    21462134
    21472135      subroutine iso_verif_traceur(x,err_msg)
    2148         USE infotrac_phy, ONLY: ntraciso
    21492136        use isotrac_mod, only: ridicule_trac
    21502137        implicit none
    … …  
    21742161      subroutine iso_verif_traceur_retourne3D(x,n1,n2,n3, &
    21752162     &           i1,i2,i3,err_msg)
    2176         USE infotrac_phy, ONLY: ntraciso
    21772163        use isotrac_mod, only: ridicule_trac
    21782164
    … …  
    22072193        subroutine iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
    22082194     &           i1,i2,i3,i4,err_msg)
    2209         USE infotrac_phy, ONLY: ntraciso
    22102195        use isotrac_mod, only: ridicule_trac
    22112196
    … …  
    22412226      subroutine iso_verif_traceur_retourne2D(x,n1,n2, &
    22422227     &           i1,i2,err_msg)
    2243         USE infotrac_phy, ONLY: ntraciso
    22442228        use isotrac_mod, only: ridicule_trac
    22452229        implicit none
    … …  
    22722256
    22732257        subroutine iso_verif_traceur_vect(x,n,m,err_msg)
    2274         USE infotrac_phy, ONLY: ntraciso
    22752258        USE isotopes_mod, ONLY: iso_HDO
    22762259        implicit none
    … …  
    23082291
    23092292        subroutine iso_verif_tracnps_vect(x,n,m,err_msg)
    2310         USE infotrac_phy, ONLY: ntraciso
    23112293        USE isotopes_mod, ONLY: iso_HDO
    23122294        implicit none
    … …  
    23422324
    23432325        subroutine iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
    2344         USE infotrac_phy, ONLY: ntraciso,niso
    23452326        implicit none
    23462327       
    … …  
    23862367        subroutine iso_verif_trac_masse_vect(x,n,m,err_msg, &
    23872368     &            errmax,errmaxrel)
    2388         USE infotrac_phy, ONLY: index_trac,ntraciso,niso
    2389         use isotopes_mod, only: striso
    2390         use isotrac_mod, only: ntraceurs_zone
     2369        use isotopes_mod, only: isoName
    23912370        implicit none
    23922371       
    … …  
    24092388          xtractot(i,j)=0.0
    24102389          xiiso(i,j)=x(iiso,i,j)
    2411           do izone=1,ntraceurs_zone 
    2412             ixt=index_trac(izone,iiso)
     2390          do izone=1,nzone
     2391            ixt=itZonIso(izone,iiso)
    24132392            xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)           
    2414           enddo !do izone=1,ntraceurs_zone
     2393          enddo !do izone=1,nzone
    24152394         enddo !do i=1,n
    24162395        enddo !do j=1,m
    … …  
    24192398        call iso_verif_egalite_std_vect( &
    24202399     &           xtractot,xiiso, &
    2421      &           err_msg//', verif trac egalite, iso '//striso(iiso), &
     2400     &           err_msg//', verif trac egalite, iso ' &
     2401     &           //TRIM(isoName(iiso)), &
    24222402     &           n,m,errmax,errmaxrel)
    24232403        enddo !do iiso=1,niso
    … …  
    24262406
    24272407        subroutine iso_verif_tracdd_vect(x,n,m,err_msg)
    2428         use infotrac_phy, only: index_trac,ntraciso,niso
    24292408        use isotopes_mod, only: iso_HDO,iso_eau
    2430         use isotrac_mod, only: strtrac,ntraceurs_zone
     2409        use isotrac_mod, only: strtrac
    24312410        implicit none
    24322411       
    … …  
    24432422
    24442423       if (iso_HDO.gt.0) then
    2445         do izone=1,ntraceurs_zone
    2446           ieau=index_trac(izone,iso_eau)
     2424        do izone=1,nzone
     2425          ieau=itZonIso(izone,iso_eau)
    24472426          do iiso=1,niso
    2448            ixt=index_trac(izone,iiso)
     2427           ixt=itZonIso(izone,iiso)
    24492428           do j=1,m
    24502429            do i=1,n
    … …  
    24632442     &           xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
    24642443     &           deltalimtrac)
    2465          enddo !do izone=1,ntraceurs_zone
     2444         enddo !do izone=1,nzone
    24662445        endif !if (iso_HDO.gt.0) then
    24672446
    … …  
    24692448
    24702449        subroutine iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
    2471         USE infotrac_phy, ONLY: ntraciso,niso
    24722450        implicit none
    24732451
    … …  
    25112489
    25122490        subroutine iso_verif_tracnps(x,err_msg)
    2513         USE infotrac_phy, ONLY: ntraciso
    25142491        use isotrac_mod, only: ridicule_trac
    25152492
    … …  
    25382515
    25392516        subroutine iso_verif_tracpos_choix(x,err_msg,seuil)
    2540         USE infotrac_phy, ONLY: ntraciso
    25412517        implicit none
    25422518        ! vérifier des choses sur les traceurs
    … …  
    25642540        subroutine iso_verif_traceur_choix(x,err_msg, &
    25652541     &       errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
    2566         USE infotrac_phy, ONLY: ntraciso
    25672542        implicit none
    25682543        ! vérifier des choses sur les traceurs
    … …  
    25872562
    25882563        function iso_verif_traceur_nostop(x,err_msg)
    2589         USE infotrac_phy, ONLY: ntraciso
    25902564        use isotrac_mod, only: ridicule_trac
    25912565        !use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
    … …  
    26162590
    26172591      subroutine iso_verif_traceur_justmass(x,err_msg)
    2618         USE infotrac_phy, ONLY: ntraciso
    26192592        implicit none
    26202593        ! on vérifie que noNaN et masse
    … …  
    26452618
    26462619        function iso_verif_traceur_jm_nostop(x,err_msg)
    2647         USE infotrac_phy, ONLY: ntraciso
    26482620        implicit none
    26492621        ! on vérifie que noNaN et masse
    … …  
    26772649        end function iso_verif_traceur_jm_nostop
    26782650
    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
     2651        subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
     2652        USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
     2653        use isotrac_mod, only: option_traceurs,nzone_temp
    26832654        implicit none
    26842655
    26852656        ! inputs
    2686         real x(ntraciso)
     2657        integer n,m
     2658        real x(ntraciso,n,m)
    26872659        character*(*) err_msg
    2688         ! output
    2689         integer iso_verif_tag17_q_deltaD_chns
     2660
    26902661        ! locals
    26912662        !integer iso_verif_positif_nostop
    26922663        !real deltaD
    26932664        integer ieau,ixt,ieau1
    2694 
    2695         iso_verif_tag17_q_deltaD_chns=0
     2665        integer i,k
    26962666
    26972667        if ((option_traceurs.eq.17).or. &
    … …  
    26992669        ! verifier que deltaD du tag de la couche la plus haute <
    27002670        ! 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
    2731 
    2732         subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
    2733         USE infotrac_phy, ONLY: index_trac,ntraciso
    2734         USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
    2735         use isotrac_mod, only: option_traceurs,nzone_temp
    2736         implicit none
    2737 
    2738         ! inputs
    2739         integer n,m
    2740         real x(ntraciso,n,m)
    2741         character*(*) err_msg
    2742 
    2743         ! locals
    2744         !integer iso_verif_positif_nostop
    2745         !real deltaD
    2746         integer ieau,ixt,ieau1
    2747         integer i,k
    2748 
    2749         if ((option_traceurs.eq.17).or. &
    2750      &           (option_traceurs.eq.18)) then
    2751         ! verifier que deltaD du tag de la couche la plus haute <
    2752         ! 200 permil, et vérifier que son q est inférieur à
    2753         ieau=index_trac(nzone_temp,iso_eau)
    2754         ixt=index_trac(nzone_temp,iso_HDO)
    2755         ieau1=index_trac(1,iso_eau)
     2671        ieau=itZonIso(nzone_temp,iso_eau)
     2672        ixt=itZonIso(nzone_temp,iso_HDO)
     2673        ieau1=itZonIso(1,iso_eau)
    27562674        do i=1,n
    27572675         do k=1,m
    … …  
    27912709
    27922710        subroutine iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
    2793         USE infotrac_phy, ONLY: index_trac,ntraciso
    27942711        USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
    27952712        use isotrac_mod, only: option_traceurs,nzone_temp
    … …  
    28112728        ! verifier que deltaD du tag de la couche la plus haute <
    28122729        ! 200 permil, et vérifier que son q est inférieur à
    2813         ieau=index_trac(nzone_temp,iso_eau)
    2814         ixt=index_trac(nzone_temp,iso_HDO)
    2815         ieau1=index_trac(1,iso_eau)
     2730        ieau=itZonIso(nzone_temp,iso_eau)
     2731        ixt=itZonIso(nzone_temp,iso_HDO)
     2732        ieau1=itZonIso(1,iso_eau)
    28162733        do iq=1,nq
    28172734        do i=1,n

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/isotrac_mod.F90

    r3927 r4368  
    11#ifdef ISO
    22#ifdef ISOTRAC
    3 ! $Id: $
    43
    54MODULE isotrac_mod
    6 use infotrac_phy, ONLY: niso,ntraciso,ntraceurs_zone
    7 use isotopes_mod, only: ridicule
    8 
    9 IMPLICIT NONE
    10 SAVE
    11 
    12 ! contient toutes les variables traceurs isotopiques + les routines specifiquement
    13 ! traceurs isotopiques
    14 
    15       real ridicule_trac
    16       parameter (ridicule_trac=ridicule*1e4)
    17 
    18 integer, save ::  option_traceurs
    19 integer, save ::  ntraceurs_zone_opt ! ntraceurs_zone propre à l'option
    20 ! on vérifie que ça correspond bien à ntraceurs_zone d'infotrac
    21 integer, save ::  ntraceurs_zoneOR
    22 !$OMP THREADPRIVATE(option_traceurs,ntraceurs_zone_opt,ntraceurs_zoneOR)
    23 integer, save ::  initialisation_isotrac
    24                 ! 1 pour idéalisé
    25                 ! 0 pour lecture dans fichier
    26 !$OMP THREADPRIVATE(initialisation_isotrac)
    27 
    28 ! variables spécifiques aux différentes options, mais necessaires au
    29 ! calcul du nombre de zones de traceurs
    30 ! si option=3
    31 integer, save :: use_bassin_atlantic
    32 !$OMP THREADPRIVATE(use_bassin_atlantic)
    33 integer, save :: use_bassin_medit
    34 !$OMP THREADPRIVATE(use_bassin_medit)
    35 integer, save :: use_bassin_indian
    36 !$OMP THREADPRIVATE(use_bassin_indian)
    37 integer, save :: use_bassin_austral
    38 !$OMP THREADPRIVATE(use_bassin_austral)
    39 integer, save :: use_bassin_pacific
    40 !$OMP THREADPRIVATE(use_bassin_pacific)
    41 integer, save :: use_bassin_merarabie
    42 !$OMP THREADPRIVATE(use_bassin_merarabie)
    43 integer, save :: use_bassin_golfebengale
    44 !$OMP THREADPRIVATE(use_bassin_golfebengale)
    45 integer, save :: use_bassin_indiansud
    46 !$OMP THREADPRIVATE(use_bassin_indiansud)
    47 integer, save :: use_bassin_tropics
    48 !$OMP THREADPRIVATE(use_bassin_tropics)
    49 integer, save :: use_bassin_midlats
    50 !$OMP THREADPRIVATE(use_bassin_midlats)
    51 integer, save :: use_bassin_hauteslats
    52 !$OMP THREADPRIVATE(use_bassin_hauteslats)
    53 integer, save :: bassin_atlantic
    54 !$OMP THREADPRIVATE(bassin_atlantic)
    55 integer, save :: bassin_medit
    56 !$OMP THREADPRIVATE(bassin_medit)
    57 integer, save :: bassin_indian
    58 !$OMP THREADPRIVATE(bassin_indian)
    59 integer, save :: bassin_austral
    60 !$OMP THREADPRIVATE(bassin_austral)
    61 integer, save :: bassin_pacific
    62 !$OMP THREADPRIVATE(bassin_pacific)
    63 integer, save :: bassin_merarabie
    64 !$OMP THREADPRIVATE(bassin_merarabie)
    65 integer, save :: bassin_golfebengale
    66 !$OMP THREADPRIVATE(bassin_golfebengale)
    67 integer, save :: bassin_indiansud
    68 !$OMP THREADPRIVATE(bassin_indiansud)
    69 integer, save :: bassin_tropics
    70 !$OMP THREADPRIVATE(bassin_tropics)
    71 integer, save :: bassin_midlats
    72 !$OMP THREADPRIVATE(bassin_midlats)
    73 integer, save :: bassin_hauteslats
    74 !$OMP THREADPRIVATE(bassin_hauteslats)
    75 ! si option=4
    76 integer nzone_temp
    77 parameter (nzone_temp=1)
    78 real, save :: zone_temp1,zone_tempf,zone_tempa 
    79 !$OMP THREADPRIVATE(zone_temp1,zone_tempf,zone_tempa)
    80 ! si option 14
    81 integer nzone_lat
    82 parameter (nzone_lat=4)
    83 integer nzone_pres
    84 parameter (nzone_pres=3)
    85 real, save :: zone_pres1,zone_presf,zone_presa
    86 !$OMP THREADPRIVATE(zone_pres1,zone_presf,zone_presa)
    87 real, save :: dlattag,lattag_min
    88 !$OMP THREADPRIVATE(dlattag,lattag_min)
    89 
    90 
    91 ! option 1: on trace evap ocean et continent séparement 
     5  USE infotrac_phy,      ONLY: niso, ntiso, nzone
     6  USE readTracFiles_mod, ONLY: delPhase
     7  USE isotopes_mod,      ONLY: ridicule, get_in
     8
     9  IMPLICIT NONE
     10  SAVE
     11
     12!=== CONTENT: ALL THE ISOTOPIC TRACERS RELATED VARIABLES ===
     13!
     14! option 1: on trace evap ocean et continent separement 
    9215! option 2: on trace evap ocean, continent et evap precip
    93 ! option 3: on trace evap différents bassins océaniques
    94 !       + continents + résidu
    95 !       attention, choisir dans ce cas les bassins océaniques
     16! option 3: on trace evap differents bassins oceaniques
     17!       + continents + residu
     18!       attention, choisir dans ce cas les bassins oceaniques
    9619!       dans iso_traceurs_opt3F90.h
    97 ! option 4: tracage par température minimale
    98 !       dans ce cas, on définit des bins dans iso_traceurs_opt4.h
    99 ! option 5: pour AMMA: on taggue résidu/AEJ/flux mousson/Harmattan
     20! option 4: tracage par temperature minimale
     21!       dans ce cas, on definit des bins dans iso_traceurs_opt4.h
     22! option 5: pour AMMA: on taggue residu/AEJ/flux mousson/Harmattan
    10023! option 6: taggage des ddfts
    101 ! option 7: pour Sandrine: taggage de la vapeur à 700hPa pour omega500<-20 TODO
    102 ! option 8: pour Sandrine: taggage de la vapeur entre 950 et 800hPa, omega de 0 à 25 hPa et de l'évaoration en omega<-20. TODO
     24! option 7: pour Sandrine: taggage de la vapeur a 700hPa pour omega500<-20 TODO
     25! option 8: pour Sandrine: taggage de la vapeur entre 950 et 800hPa, omega de 0 a 25 hPa et de l'evaoration en omega<-20. TODO
    10326! option 9: taggage du condensat et de la revap precip
    10427! option 10: taggage evap oce, transpiration et evaporation
    … …  
    10730! option 12: taggage evap oce, sol nu, canop et reste evap cont.
    10831! A utiliser quand on couple avec ORCHIDEE
    109 ! option 13: taggage température minimale + revap precip
    110 ! option 14: taggage lat et altitude de dernière saturation (niveaux de pression) + evap surf
     32! option 13: taggage temperature minimale + revap precip
     33! option 14: taggage lat et altitude de derniere saturation (niveaux de pression) + evap surf
    11134! otion 15: taggage irrigation
    11235! option 16: taggage precip selon saisons et fonte neige: seulement pour ORCHIDEE
    113 ! option 17: taggage température minimum de condensation directement dans la convection et la cond LS, + evap sfc, condensat et precipitation
     36! option 17: taggage temperature minimum de condensation directement dans la convection et la cond LS, + evap sfc, condensat et precipitation
    11437! option 18: idem 17 mais on tague qsmin au lieu de Tmin
    11538! option 19: on tag vap residuelle, vap residuelle dans ddfts, sfc, cond, rev
    11639! option 20: on taggue vapeur tropicale vs vapeur extratropicale
    11740! option 21: taggage de 2 boites 3D: extratropiques (>35°) et UT tropicale (15-15°, > 500hPa)
    118 ! option 22: tagage de la vapeur proccessée dans les zones très convectives
     41! option 22: tagage de la vapeur proccessee dans les zones tres convectives
    11942               
    120         ! ces variables sont initialisées dans traceurs_init
     43   !--- nzone_opt (value of nzone for the selected option) must be equal to nzone as defined in onfotrac
     44   REAL, PARAMETER :: ridicule_trac = ridicule * 1e4
     45   INTEGER, SAVE :: option_traceurs, nzone_opt, nzoneOR
     46!$OMP THREADPRIVATE(option_traceurs,nzone_opt,nzoneOR)
     47   INTEGER, SAVE :: initialisation_isotrac
     48!$OMP THREADPRIVATE(initialisation_isotrac)     
     49                ! 1 pour idealise
     50                ! 0 pour lecture dans fichier
     51
     52   !=== VARIABLES SPECIFIC TO THE SELECTED OPTION, BUT NEEDED FOR THE COMPUTATION OF THE NUMBER OF ZONES ; TO BE INITIALIZED IN traceurs_init
     53
     54   !--- option 3
     55   LOGICAL, SAVE :: use_bassin_Austral, use_bassin_Atlantic, use_bassin_MidLats, use_bassin_SouthIndian, use_bassin_MerArabie
     56!$OMP THREADPRIVATE(use_bassin_Austral, use_bassin_Atlantic, use_bassin_MidLats, use_bassin_SouthIndian, use_bassin_MerArabie)
     57   INTEGER, SAVE ::     bassin_Austral,     bassin_Atlantic,     bassin_MidLats,     bassin_SouthIndian,     bassin_MerArabie
     58!$OMP THREADPRIVATE(    bassin_Austral,     bassin_Atlantic,     bassin_MidLats,     bassin_SouthIndian,     bassin_MerArabie)
     59   LOGICAL, SAVE :: use_bassin_Pacific, use_bassin_Indian,   use_bassin_Tropics, use_bassin_BengalGolf,  use_bassin_HighLats, use_bassin_Medit
     60!$OMP THREADPRIVATE(use_bassin_Pacific, use_bassin_Indian,   use_bassin_Tropics, use_bassin_BengalGolf,  use_bassin_HighLats, use_bassin_Medit)
     61   INTEGER, SAVE ::     bassin_Pacific,     bassin_Indian,       bassin_Tropics,     bassin_BengalGolf,      bassin_HighLats,     bassin_Medit
     62!$OMP THREADPRIVATE(    bassin_Pacific,     bassin_Indian,       bassin_Tropics,     bassin_BengalGolf,      bassin_HighLats,     bassin_Medit)
     63
     64   !--- option 4
     65   INTEGER, PARAMETER :: nzone_temp = 1
     66   REAL,   SAVE ::  zone_temp1, zone_tempf, zone_tempa 
     67!$OMP THREADPRIVATE(zone_temp1, zone_tempf, zone_tempa)
     68   REAL,   SAVE ::  zone_temp(nzone_temp-1)
     69!$OMP THREADPRIVATE(zone_temp)
     70
     71   !--- option 5
     72   INTEGER, SAVE :: izone_aej, izone_harmattan, izone_mousson
     73!$OMP THREADPRIVATE(izone_aej, izone_harmattan, izone_mousson)
     74
     75   !--- option 6
     76   INTEGER, SAVE :: izone_ddft
     77!$OMP THREADPRIVATE(izone_ddft)
     78
     79   !--- option 10
     80   INTEGER, SAVE :: izone_contfrac
     81!$OMP THREADPRIVATE(izone_contfrac)
     82
     83   !--- option 12       
     84   INTEGER, SAVE :: izone_contcanop
     85!$OMP THREADPRIVATE(izone_contcanop)
     86
     87   !--- option 13
     88   INTEGER, PARAMETER :: nzone_pres = 3
     89   REAL, SAVE ::  zone_pres(nzone_pres-1)
     90!$OMP THREADPRIVATE(zone_pres)
     91
     92   !--- option 14
     93   INTEGER, PARAMETER :: nzone_lat = 4
     94   REAL,    SAVE :: zone_pres1, zone_presf, zone_presa
     95!$OMP THREADPRIVATE(zone_pres1, zone_presf, zone_presa)
     96   REAL,    SAVE :: dlattag, lattag_min, zone_lat(nzone_lat-1)
     97!$OMP THREADPRIVATE(dlattag, lattag_min, zone_lat)
     98
     99   !--- option 15
     100   INTEGER, SAVE :: izone_irrig
     101!$OMP THREADPRIVATE(izone_irrig)
     102
     103   !--- option 17
     104   REAL,    SAVE :: seuil_tag_tmin, seuil_tag_tmin_ls
     105!$OMP THREADPRIVATE(seuil_tag_tmin, seuil_tag_tmin_ls)
     106  INTEGER,  SAVE :: option_seuil_tag_tmin
     107!$OMP THREADPRIVATE(option_seuil_tag_tmin)
     108
     109   !--- option 20
     110   INTEGER, SAVE :: izone_trop, izone_extra
     111!$OMP THREADPRIVATE(izone_trop, izone_extra)
     112   REAL,    SAVE :: lim_tag20
     113!$OMP THREADPRIVATE(lim_tag20)
     114
     115   !--- option 21: on garde izone_trop, izone_extra 
     116
     117   !--- option 22
     118   INTEGER, SAVE :: izone_conv_BT, izone_conv_UT
     119!$OMP THREADPRIVATE(izone_conv_BT, izone_conv_UT)
     120   REAL,    SAVE :: lim_precip_tag22
     121!$OMP THREADPRIVATE(lim_precip_tag22)
     122
    121123       
    122 !integer ntraciso
    123 !parameter (ntraciso=(ntraceurs_zone+1)*niso)
    124 !integer ntracisoOR ! défini dans traceurs_init
    125 integer, ALLOCATABLE, DIMENSION(:), save :: index_iso
    126 !$OMP THREADPRIVATE(index_iso)
    127 integer, ALLOCATABLE, DIMENSION(:), save ::  index_zone
    128 !$OMP THREADPRIVATE(index_zone)
    129 integer, ALLOCATABLE, DIMENSION(:,:), save ::  index_trac_loc ! il y a déjà un index_trac dans infotrac: vérifier que c'est le même
    130 !$OMP THREADPRIVATE(index_trac_loc)
    131 character*3, ALLOCATABLE, DIMENSION(:), save :: strtrac
    132 !$OMP THREADPRIVATE(strtrac)
    133 ! -> tout ça passe maintenant par infotrac
    134 
    135 integer, ALLOCATABLE, DIMENSION(:), save :: bassin_map
    136 integer, ALLOCATABLE, DIMENSION(:,:), save :: boite_map
    137 !$OMP THREADPRIVATE(bassin_map,boite_map)
    138 
    139 
    140         ! traitement recyclage et evap
    141 integer, save :: izone_cont ! pour le recyclage continental
    142 !$OMP THREADPRIVATE(izone_cont)
    143 integer, save :: izone_oce ! pour l'océan
    144 !$OMP THREADPRIVATE(izone_oce)
    145 integer, save :: izone_poubelle ! pour les petits résidus numériques
     124  INTEGER, ALLOCATABLE, SAVE :: index_iso(:), index_zone(:), itZonIso_loc(:,:)
     125!$OMP THREADPRIVATE(            index_iso,    index_zone,    itZonIso_loc)
     126  CHARACTER(LEN=3), ALLOCATABLE :: strtrac(:)
     127!$OMP THREADPRIVATE(               strtrac)
     128  INTEGER, ALLOCATABLE, SAVE :: bassin_map(:), boite_map(:,:)
     129!$OMP THREADPRIVATE(            bassin_map,    boite_map)
     130
     131   !=== RECYCLING AND EVAPORATION TREATMENT
     132   INTEGER, SAVE :: izone_cont, izone_oce        !--- For land and ocean recycling
     133!$OMP THREADPRIVATE(izone_cont, izone_oce)
     134   INTEGER, SAVE :: izone_poubelle               !--- For small numerical residues
    146135!$OMP THREADPRIVATE(izone_poubelle)
    147 integer, save :: izone_init ! pour l'initialisation par défaut
     136   INTEGER, SAVE :: izone_init                   !--- For default initialization
    148137!$OMP THREADPRIVATE(izone_init)
    149 integer, save :: izone_revap ! pour l'évap des gouttes
     138   INTEGER, SAVE :: izone_revap                  !--- For droplets evaporation
    150139!$OMP THREADPRIVATE(izone_revap)
    151 integer, save :: option_revap
    152 !$OMP THREADPRIVATE(option_revap)
    153 integer, save :: option_tmin
    154 !$OMP THREADPRIVATE(option_tmin)
    155 integer, save :: option_cond
    156 !$OMP THREADPRIVATE(option_cond)
    157 integer, save :: izone_cond
    158 !$OMP THREADPRIVATE(izone_cond)
    159 real evap_franche
    160 parameter (evap_franche=1e-6) ! en kg/m2/s
    161 
    162 ! specifique à option 4:
    163 real, save ::  zone_temp(nzone_temp-1)
    164 !$OMP THREADPRIVATE(zone_temp)
    165 ! si option 5
    166 integer, save :: izone_aej
    167 !$OMP THREADPRIVATE(izone_aej)
    168 integer, save :: izone_harmattan
    169 !$OMP THREADPRIVATE(izone_harmattan)
    170 integer, save :: izone_mousson
    171 !$OMP THREADPRIVATE(izone_mousson)
    172 ! si option 6
    173 integer, save :: izone_ddft
    174 !$OMP THREADPRIVATE(izone_ddft)
    175 ! si option 10
    176 integer, save :: izone_contfrac
    177 !$OMP THREADPRIVATE(izone_contfrac)
    178 ! si option 12 
    179 integer, save :: izone_contcanop
    180 !$OMP THREADPRIVATE(izone_contcanop)
    181 ! specifique à option 13:
    182 real, save ::  zone_pres(nzone_pres-1)
    183 !$OMP THREADPRIVATE(zone_pres)
    184 ! si option 14
    185 real, save ::  zone_lat(nzone_lat-1)
    186 !$OMP THREADPRIVATE(zone_lat)
    187 ! si option 15
    188 integer, save :: izone_irrig
    189 !$OMP THREADPRIVATE(izone_irrig)
    190 ! si option 17
    191 real, save ::  seuil_tag_tmin
    192 !$OMP THREADPRIVATE(seuil_tag_tmin)
    193 real, save ::  seuil_tag_tmin_ls
    194 !$OMP THREADPRIVATE(seuil_tag_tmin_ls)
    195 integer, save :: option_seuil_tag_tmin
    196 !$OMP THREADPRIVATE(option_seuil_tag_tmin)
    197 ! si option 20
    198 integer, save :: izone_trop,izone_extra
    199 real, save ::  lim_tag20
    200 !$OMP THREADPRIVATE(izone_trop,izone_extra,lim_tag20)
    201 ! si option 21: on garde izone_trop,izone_extra 
    202 ! si opt 22
    203 integer, save :: izone_conv_BT,izone_conv_UT
    204 real, save ::  lim_precip_tag22
    205 !$OMP THREADPRIVATE(izone_conv_BT,izone_conv_UT,lim_precip_tag22)
    206 
     140   INTEGER, SAVE :: option_revap, option_tmin, option_cond, izone_cond
     141!$OMP THREADPRIVATE(option_revap, option_tmin, option_cond, izone_cond)
     142   REAL, PARAMETER :: evap_franche = 1e-6        !--- In kg/m2/s
    207143
    208144CONTAINS
    209145
    210       subroutine iso_traceurs_init()
    211 
    212       use IOIPSL ! getin
    213       USE infotrac_phy, ONLY: ntraciso,niso,ntraceurs_zone,index_trac
    214       USE isotopes_mod, ONLY: iso_eau,ntracisoOR,initialisation_iso, &
    215 &               iso_eau_possible
    216       USE dimphy, only: klon,klev
    217 
    218         implicit none
    219 
    220 
    221         ! définition de quelles zones et quelles isotopes représentent
    222         ! les traceurs
    223 
    224         ! inputs, outputs
    225         ! ! c'est les variables dans traceurs.h qui sont modifiées
    226 
    227         ! locals
    228         integer itrac,izone,ixt,k
    229         integer izone_pres,izone_lat
    230         character*2 strz,strz_preslat
    231         character*1 strz_pres,strz_lat
    232         integer ntraceurs_zone_opt
    233 
    234         ! vérifier que on a bien l'eau comme traceurs
    235         if (iso_eau.eq.0) then
    236             write(*,*) 'traceurs_init 18: isotrac ne marche que si ', &
    237      &            'on met l''eau comme isotope'
    238             stop
    239         endif
    240 
    241         ! initialiser
    242         option_traceurs=0
    243         initialisation_isotrac=0
    244 
    245         ! allouer
    246         allocate (index_iso(ntraciso))
    247         allocate (index_zone(ntraciso))
    248         allocate (index_trac_loc(ntraceurs_zone,niso))
    249         allocate (strtrac(ntraceurs_zone))
    250         allocate (bassin_map(klon))
    251         allocate (boite_map(klon,klev))
    252 
    253         if (initialisation_iso.eq.0) then
    254           call getin('initialisation_isotrac',initialisation_isotrac)
    255           write(*,*) 'initialisation_isotrac=',initialisation_isotrac
    256         endif !if (initialisation_iso.eq.0) then
    257 
    258         ! lire l'option de traçage
    259         call getin('option_traceurs',option_traceurs)
    260         write(*,*) 'option_traceurs=',option_traceurs
    261 
    262         ! cas général: pas de traceurs dans ORCHIDEE
    263         ntracisoOR=niso
    264 
    265         ! partie à éditer ! pour définir les différentes zones
    266         if (option_traceurs.eq.1) then
    267           ! on trace continents/ocean 
    268 
    269           ntraceurs_zone_opt=2
    270           izone_cont=1
    271           izone_oce=2         
    272           izone_poubelle=2 ! zone où on met les flux non physiques, de
    273                 ! réajustement
    274           izone_init=2 ! zone d'initialisation par défaut         
    275           option_revap=0
    276           option_tmin=0
    277           izone_revap=0
    278           option_cond=0
    279 
    280           strtrac(izone_cont)='con'
    281           strtrac(izone_oce)='oce'
    282 
    283         elseif (option_traceurs.eq.2) then
    284           ! on trace continent/ ocean/reevap des gouttes
    285 
    286           ntraceurs_zone_opt=3
    287           izone_cont=1
    288           izone_oce=2
    289           izone_poubelle=2 ! zone où on met les flux non physiques, de
    290                 ! réajustement
    291           izone_init=2 ! zone d'initialisation par défaut
    292           option_revap=1
    293           option_tmin=0
    294           izone_revap=3
    295           option_cond=0
    296 
    297           strtrac(izone_cont)='con'
    298           strtrac(izone_oce)='oce'
    299           strtrac(izone_revap)='rev'
    300          
    301 
    302         else if (option_traceurs.eq.3) then
    303             ! on trace des bassins océaniques + un résidu. On ne trace
    304             ! pas l'évap des gouttes à part
    305             ! le résidu est la dernère dimension
    306            
    307           ! lire les use_bassin
    308           call getin('use_bassin_atlantic',use_bassin_atlantic)     
    309           call getin('use_bassin_medit',use_bassin_medit)     
    310           call getin('use_bassin_indian',use_bassin_indian)     
    311           call getin('use_bassin_austral',use_bassin_austral)     
    312           call getin('use_bassin_pacific',use_bassin_pacific)     
    313           call getin('use_bassin_merarabie',use_bassin_merarabie)     
    314           call getin('use_bassin_golfebengale',use_bassin_golfebengale)     
    315           call getin('use_bassin_indiansud',use_bassin_indiansud)     
    316           call getin('use_bassin_tropics',use_bassin_tropics)     
    317           call getin('use_bassin_midlats',use_bassin_midlats)     
    318           call getin('use_bassin_hauteslats',use_bassin_hauteslats)
    319 
    320           write(*,*) 'use_bassin_atlantic=' ,use_bassin_atlantic 
    321           write(*,*) 'use_bassin_medit=' ,use_bassin_medit
    322           write(*,*) 'use_bassin_indian=' ,use_bassin_indian
    323           write(*,*) 'use_bassin_austral=' ,use_bassin_austral
    324           write(*,*) 'use_bassin_merarabie=' ,use_bassin_merarabie
    325           write(*,*) 'use_bassin_golfebengale=' ,use_bassin_golfebengale
    326           write(*,*) 'use_bassin_indiansud=' ,use_bassin_indiansud
    327           write(*,*) 'use_bassin_tropics=' ,use_bassin_tropics
    328           write(*,*) 'use_bassin_midlats=' ,use_bassin_midlats
    329           write(*,*) 'use_bassin_hauteslats=' ,use_bassin_hauteslats
    330 
    331        
    332           ntraceurs_zone_opt=2 &
    333      &                   +use_bassin_atlantic &
    334      &                   +use_bassin_medit &
    335      &                   +use_bassin_indian &
    336      &                   +use_bassin_austral &
    337      &                   +use_bassin_pacific &
    338      &                   +use_bassin_merarabie &
    339      &                   +use_bassin_golfebengale &
    340      &                   +use_bassin_indiansud &
    341      &                   +use_bassin_tropics &
    342      &                   +use_bassin_midlats &
    343      &                   +use_bassin_hauteslats
    344 
    345           izone_cont=ntraceurs_zone
    346           izone_oce=0 ! pas de sens car séparée en bassins         
    347           izone_poubelle=ntraceurs_zone-1 ! zone où on met les flux non physiques, de
    348                 ! réajustement
    349           izone_init=ntraceurs_zone-1 ! zone d'initialisation par défaut
    350           option_revap=0 ! on ne trace pas les gouttes
    351           option_tmin=0
    352           izone_revap=0 ! pas de sens car on taggue pas les gouttes séparemment 
    353           option_cond=0
    354 
    355           ! si on a use_bassin_indian, on n'a pas le découpage détaillé
    356           ! de l'indian:
     146   SUBROUTINE iso_traceurs_init()
     147
     148   USE infotrac_phy, ONLY: itZonIso, isoName, isoZone
     149   USE isotopes_mod, ONLY: iso_eau, ntracisoOR, initialisation_iso
     150   USE dimphy,       ONLY: klon, klev
     151   USE  strings_mod, ONLY: int2str, strStack, strTail, strHead, fmsg
     152
     153   IMPLICIT NONE
     154   ! Define which zones and isotopes correspond to isotopic tagging tracers
     155   ! Modify traceurs.h variables
     156   INTEGER :: izone, ixt, k
     157   INTEGER :: izone_pres, izone_lat
     158   INTEGER :: nzone_opt
     159
     160   IF(fmsg("traceurs_init 18: isotrac ne marche que si on met l'eau comme isotope", 'iso_traceurs_init', iso_eau==0)) STOP
     161
     162   !--- Initialize
     163   option_traceurs = 0
     164   initialisation_isotrac = 0
     165
     166   !--- Allocate
     167   ALLOCATE(index_iso (ntiso))
     168   ALLOCATE(index_zone(ntiso))
     169   ALLOCATE(itZonIso_loc(nzone,niso))
     170   ALLOCATE(strtrac(nzone))
     171   ALLOCATE(bassin_map(klon))
     172   ALLOCATE( boite_map(klon,klev))
     173
     174   IF(initialisation_iso == 0) CALL get_in('initialisation_isotrac', initialisation_isotrac)
     175
     176   !--- Read tracing option
     177   CALL get_in('option_traceurs', option_traceurs)
     178
     179   !--- Genral case: no traceurs in ORCHIDEE
     180   ntracisoOR=niso
     181
     182   ! partie a editer ! pour definir les differentes zones
     183   SELECT CASE(option_traceurs)
     184      !========================================================================================================================
     185      CASE(1)      !=== TRACING LAND/OCEAN
     186      !========================================================================================================================
     187         nzone_opt=2
     188         izone_cont=1
     189         izone_oce=2
     190         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     191         izone_init=2        ! zone d'initialisation par defaut         
     192         option_revap=0
     193         option_tmin=0
     194         izone_revap=0
     195         option_cond=0
     196         strtrac(izone_cont) = 'con'
     197         strtrac(izone_oce)  = 'oce'
     198      !========================================================================================================================
     199      CASE(2)      !=== TRACING LAND/OCEAN/DROPLETS REEVAPORATION
     200      !========================================================================================================================
     201         nzone_opt=3
     202         izone_cont=1
     203         izone_oce=2
     204         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     205         izone_init=2        ! zone d'initialisation par defaut         
     206         option_revap=1
     207         option_tmin=0
     208         izone_revap=3
     209         option_cond=0
     210         strtrac(izone_cont) = 'con'
     211         strtrac(izone_oce)  = 'oce'
     212         strtrac(izone_revap)= 'rev'
     213      !========================================================================================================================
     214      CASE(3)      !=== TRACING OCEANS BASINS + RESIDUE (LAST DIMENSION). NO DROPLETS EVAPORATION TRACING.
     215      !========================================================================================================================
     216         ! lire les use_bassin
     217         CALL get_in('use_bassin_Atlantic',   use_bassin_Atlantic)
     218         CALL get_in('use_bassin_Medit',      use_bassin_Medit)
     219         CALL get_in('use_bassin_Indian',     use_bassin_Indian)
     220         CALL get_in('use_bassin_Austral',    use_bassin_Austral)
     221         CALL get_in('use_bassin_Pacific',    use_bassin_Pacific)
     222         CALL get_in('use_bassin_MerArabie',  use_bassin_MerArabie)
     223         CALL get_in('use_bassin_BengalGolf', use_bassin_BengalGolf)
     224         CALL get_in('use_bassin_SouthIndian',use_bassin_SouthIndian)
     225         CALL get_in('use_bassin_Tropics',    use_bassin_Tropics)
     226         CALL get_in('use_bassin_Midlats',    use_bassin_Midlats)
     227         CALL get_in('use_bassin_HighLats',   use_bassin_HighLats)
     228         nzone_opt  =  2  +  COUNT([use_bassin_Atlantic, use_bassin_Medit,     use_bassin_Indian,     &
     229            use_bassin_Austral,     use_bassin_Pacific,  use_bassin_MerArabie, use_bassin_BengalGolf, &
     230            use_bassin_SouthIndian, use_bassin_Tropics,  use_bassin_Midlats,   use_bassin_HighLats])
     231         izone_cont=nzone
     232         izone_oce=0             ! pas de sens car separee en bassins         
     233         izone_poubelle=nzone-1  ! zone ou on met les flux non physiques, de reajustement
     234         izone_init=nzone-1      ! zone d'initialisation par defaut
     235         option_revap=0          ! on ne trace pas les gouttes
     236         option_tmin=0
     237         izone_revap=0           ! pas de sens car on taggue pas les gouttes separemment 
     238         option_cond=0
    357239#ifdef ISOVERIF
    358           if (use_bassin_indian.eq.1) then
    359 !              call iso_verif_egalite(float(use_bassin_merarabie), &
    360 !     &            0.0,'iso_traceurs_init 73: revoir def des bassins')
    361                if ((use_bassin_merarabie.ne.0).or. &
    362       &            (use_bassin_indiansud.ne.0).or. &
    363       &            (use_bassin_golfebengale.ne.0)) then
    364                 write(*,*) 'traceurs_init 73'
    365                 stop
    366                endif
    367 !              call iso_verif_egalite(float(use_bassin_golfebengale), &
    368 !     &            0.0,'iso_traceurs_init 73: revoir def des bassins')
    369 !              call iso_verif_egalite(float(use_bassin_indiansud), &
    370 !     &            0.0,'iso_traceurs_init 73: revoir def des bassins')
    371           endif
     240         IF(use_bassin_Indian) THEN   !=== NON COMPATIBLE WITH A DETAILED INDIAN CUTTING
     241            IF(use_bassin_MerArabie .OR. use_bassin_SouthIndian .OR. use_bassin_BengalGolf) THEN
     242               WRITE(*,*) 'traceurs_init 73'; STOP
     243            END IF
     244!           CALL iso_verif_egalite(float(use_bassin_MerArabie),   0.0, 'iso_traceurs_init 73: revoir def des bassins')
     245!           CALL iso_verif_egalite(float(use_bassin_BengalGolf),  0.0, 'iso_traceurs_init 73: revoir def des bassins')
     246!           CALL iso_verif_egalite(float(use_bassin_SouthIndian), 0.0, 'iso_traceurs_init 73: revoir def des bassins')
     247         END IF
    372248#endif   
    373          
    374           bassin_atlantic= max(use_bassin_atlantic,1)
    375           bassin_medit=max(use_bassin_atlantic &
    376      &           +use_bassin_medit,1)
    377           bassin_indian=max(use_bassin_atlantic &
    378      &           +use_bassin_medit &
    379      &           +use_bassin_indian,1)
    380           bassin_austral=max(use_bassin_atlantic &
    381      &           +use_bassin_medit &
    382      &           +use_bassin_indian &
    383      &           +use_bassin_austral,1)
    384           bassin_pacific=max(use_bassin_atlantic &
    385      &           +use_bassin_medit &
    386      &           +use_bassin_indian &
    387      &           +use_bassin_austral &
    388      &           +use_bassin_pacific,1)
    389           bassin_merarabie=max(use_bassin_atlantic &
    390      &           +use_bassin_medit &
    391      &           +use_bassin_indian &
    392      &           +use_bassin_austral &
    393      &           +use_bassin_pacific &
    394      &           +use_bassin_merarabie,1)
    395           bassin_golfebengale=max(use_bassin_atlantic&
    396      &           +use_bassin_medit &
    397      &           +use_bassin_indian &
    398      &           +use_bassin_austral &
    399      &           +use_bassin_pacific &
    400      &           +use_bassin_merarabie &
    401      &           +use_bassin_golfebengale,1)
    402           bassin_indiansud=max(use_bassin_atlantic &
    403      &           +use_bassin_medit &
    404      &           +use_bassin_indian &
    405      &           +use_bassin_austral &
    406      &           +use_bassin_pacific &
    407      &           +use_bassin_merarabie &
    408      &           +use_bassin_golfebengale &
    409      &           +use_bassin_indiansud,1)
    410           bassin_tropics=max(use_bassin_atlantic &
    411      &                       +use_bassin_medit &
    412      &                       +use_bassin_indian &
    413      &                       +use_bassin_austral &
    414      &                       +use_bassin_pacific &
    415      &                       +use_bassin_merarabie &
    416      &                       +use_bassin_golfebengale &
    417      &                       +use_bassin_indiansud, &
    418      &                       +use_bassin_tropics,1)
    419           bassin_midlats=max(use_bassin_atlantic &
    420      &                       +use_bassin_medit &
    421      &                       +use_bassin_indian &
    422      &                       +use_bassin_austral &
    423      &                       +use_bassin_pacific &
    424      &                       +use_bassin_merarabie &
    425      &                       +use_bassin_golfebengale &
    426      &                       +use_bassin_indiansud &
    427      &                       +use_bassin_tropics &
    428      &                       +use_bassin_midlats,1)
    429           bassin_hauteslats=max(use_bassin_atlantic &
    430      &                       +use_bassin_medit &
    431      &                       +use_bassin_indian &
    432      &                       +use_bassin_austral &
    433      &                       +use_bassin_pacific &
    434      &                       +use_bassin_merarabie &
    435      &                       +use_bassin_golfebengale &
    436      &                       +use_bassin_indiansud &
    437      &                       +use_bassin_tropics &
    438      &                       +use_bassin_midlats &
    439      &                       +use_bassin_hauteslats,1)
    440 
    441           write(*,*) 'bassin_atlantic=' ,bassin_atlantic 
    442           write(*,*) 'bassin_medit=' ,bassin_medit
    443           write(*,*) 'bassin_indian=' ,bassin_indian
    444           write(*,*) 'bassin_austral=' ,bassin_austral
    445           write(*,*) 'bassin_merarabie=' ,bassin_merarabie
    446           write(*,*) 'bassin_golfebengale=' ,bassin_golfebengale
    447           write(*,*) 'bassin_indiansud=' ,bassin_indiansud
    448           write(*,*) 'bassin_tropics=' ,bassin_tropics
    449           write(*,*) 'bassin_midlats=' ,bassin_midlats
    450           write(*,*) 'bassin_hauteslats=' ,bassin_hauteslats
    451 
    452           if (use_bassin_atlantic.eq.1) then
    453             strtrac(bassin_atlantic)='atl'
    454           endif
    455           if (use_bassin_medit.eq.1) then
    456             strtrac(bassin_medit)='med'
    457           endif
    458           if (use_bassin_indian.eq.1) then
    459             strtrac(bassin_indian)='ind'
    460           endif
    461           if (use_bassin_austral.eq.1) then
    462             strtrac(bassin_austral)='aus'
    463           endif
    464           if (use_bassin_pacific.eq.1) then
    465             strtrac(bassin_pacific)='pac'
    466           endif
    467           if (use_bassin_merarabie.eq.1) then
    468             strtrac(bassin_merarabie)='ara'
    469           endif
    470           if (use_bassin_golfebengale.eq.1) then
    471             strtrac(bassin_golfebengale)='ben'
    472           endif
    473           if (use_bassin_indiansud.eq.1) then
    474             strtrac(bassin_indiansud)='ins'
    475           endif
    476           if (use_bassin_tropics.eq.1) then
    477             strtrac(bassin_tropics)='tro'
    478           endif
    479           if (use_bassin_midlats.eq.1) then
    480             strtrac(bassin_midlats)='mid'
    481           endif
    482           if (use_bassin_hauteslats.eq.1) then
    483             strtrac(bassin_hauteslats)='hau'
    484           endif
    485           strtrac(ntraceurs_zone-1)='res'
    486           strtrac(ntraceurs_zone)='con'
    487 
    488         else if (option_traceurs.eq.4) then
    489           ! on trace les température minimales vécues
    490           ! comme dans article sur LdG sauf pas de revap
    491            
    492           zone_temp1=293.0 ! en K
    493 !          zone_tempf=223.0 ! en K
    494           zone_tempf=243.0 ! en K
    495  ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détal en bas
    496 
     249         bassin_Atlantic   = 1
     250         bassin_Medit      = bassin_Atlantic    + COUNT([use_bassin_Medit]);       WRITE(*,*) 'bassin_Atlantic    =' ,bassin_Atlantic
     251         bassin_Indian     = bassin_Medit       + COUNT([use_bassin_Indian]);      WRITE(*,*) 'bassin_Medit       =' ,bassin_Medit
     252         bassin_Austral    = bassin_Indian      + COUNT([use_bassin_Austral]);     WRITE(*,*) 'bassin_Indian      =' ,bassin_Indian
     253         bassin_Pacific    = bassin_Austral     + COUNT([use_bassin_Pacific]);     WRITE(*,*) 'bassin_Austral     =' ,bassin_Austral
     254         bassin_MerArabie  = bassin_Pacific     + COUNT([use_bassin_MerArabie]);   WRITE(*,*) 'bassin_MerArabie   =' ,bassin_MerArabie
     255         bassin_BengalGolf = bassin_MerArabie   + COUNT([use_bassin_BengalGolf]);  WRITE(*,*) 'bassin_BengalGolf  =' ,bassin_BengalGolf
     256         bassin_SouthIndian= bassin_BengalGolf  + COUNT([use_bassin_SouthIndian]); WRITE(*,*) 'bassin_SouthIndian =' ,bassin_SouthIndian
     257         bassin_Tropics    = bassin_SouthIndian + COUNT([use_bassin_Tropics]);     WRITE(*,*) 'bassin_Tropics     =' ,bassin_Tropics
     258         bassin_MidLats    = bassin_Tropics     + COUNT([use_bassin_MidLats]);     WRITE(*,*) 'bassin_MidLats     =' ,bassin_MidLats
     259         bassin_HighLats   = bassin_MidLats     + COUNT([use_bassin_HighLats]);    WRITE(*,*) 'bassin_HighLats    =' ,bassin_HighLats
     260         IF(use_bassin_atlantic   ) strtrac(bassin_atlantic)   = 'atl'
     261         IF(use_bassin_medit      ) strtrac(bassin_medit)      = 'med'
     262         IF(use_bassin_indian     ) strtrac(bassin_indian)     = 'ind'
     263         IF(use_bassin_austral    ) strtrac(bassin_austral)    = 'aus'
     264         IF(use_bassin_pacific    ) strtrac(bassin_pacific)    = 'pac'
     265         IF(use_bassin_merarabie  ) strtrac(bassin_merarabie)  = 'ara'
     266         IF(use_bassin_BengalGolf ) strtrac(bassin_BengalGolf) = 'ben'
     267         IF(use_bassin_SouthIndian) strtrac(bassin_SouthIndian)= 'ins'
     268         IF(use_bassin_tropics    ) strtrac(bassin_tropics)    = 'tro'
     269         IF(use_bassin_midlats    ) strtrac(bassin_midlats)    = 'mid'
     270         IF(use_bassin_HighLats   ) strtrac(bassin_HighLats)   = 'hau'
     271         strtrac(nzone-1)='res'
     272         strtrac(nzone)='con'
     273      !========================================================================================================================
     274      CASE(4)      !=== TRACING MINIMAL EXPERIENCED TEMPERATURE AS IN THE ARTICLE ON LfG, EXCEPT NO REVAPORATION
     275      !========================================================================================================================
     276         zone_temp1 = 293.0  ! en K
     277!        zone_tempf = 223.0  ! en K
     278         zone_tempf = 243.0  ! en K
     279        ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire, <0 pour plus de detal en bas
    497280        ! zone 1: >= zone_temp1
    498         ! zone 2 à 4: intermédiaire,
     281        ! zone 2 a 4: intermediaire,
    499282        ! zone 5: <zone_tempf
    500        
    501           ntraceurs_zone_opt=nzone_temp+1
    502 
    503           zone_tempa=-4.0 ! en K
    504           izone_cont=ntraceurs_zone
    505           izone_oce=ntraceurs_zone 
    506           izone_poubelle=ntraceurs_zone
    507           izone_init=ntraceurs_zone ! zone d'initialisation par défaut
    508           option_revap=0
    509           option_tmin=0 
    510           izone_revap=0
    511           option_cond=0
    512           do izone=1,nzone_temp
    513             write(strz,'(i2.2)') izone
    514             strtrac(izone)='t'//strz
    515             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    516           enddo
    517           strtrac(izone_poubelle)='pou'
    518 
    519           ! initialisation des zones de tempéarture
    520           do izone=1,nzone_temp-1
    521             zone_temp(izone)=zone_temp1+float(izone-1) &
    522      &                      *(zone_tempa*float(izone-nzone_temp+1) &
    523      &                      +(zone_tempf-zone_temp1)/float(nzone_temp-2))
    524           enddo
    525           write(*,*) 'iso_trac_init 183: zone_temp=',zone_temp         
    526 
    527         elseif (option_traceurs.eq.5) then
    528           ! on trace AEJ/flux de mousson/Harmattan
    529 !          write(*,*) 'iso_traceurs_init 129'
    530 
    531           ntraceurs_zone_opt=4
    532           izone_cont=1
    533           izone_oce=1
    534           izone_poubelle=1 ! zone où on met les flux non physiques, de
    535                 ! réajustement
    536           izone_init=1 ! zone d'initialisation par défaut
    537           option_revap=0
    538           option_tmin=0
    539           izone_revap=0
    540           izone_aej=2
    541           izone_mousson=3
    542           izone_harmattan=4
    543           option_cond=0
    544 
    545           strtrac(izone_poubelle)='res'
    546           strtrac(izone_aej)='aej'
    547           strtrac(izone_mousson)='mou'
    548           strtrac(izone_harmattan)='sah'
    549 
    550         elseif (option_traceurs.eq.6) then
    551           ! on trace les ddfts
    552 
    553           ntraceurs_zone_opt=2
    554           izone_cont=1
    555           izone_oce=1
    556           izone_poubelle=1 ! zone où on met les flux non physiques, de
    557                 ! réajustement
    558           izone_init=1 ! zone d'initialisation par défaut
    559           option_revap=0
    560           option_tmin=0
    561           izone_revap=0
    562           izone_ddft=2
    563           option_cond=0
    564 
    565           strtrac(izone_poubelle)='res'
    566           strtrac(izone_ddft)='dft'
    567 
    568         elseif (option_traceurs.eq.9) then
    569           ! on trace le condensat
    570 
    571           ntraceurs_zone_opt=3
    572           izone_cont=1
    573           izone_oce=1
    574           izone_poubelle=1 ! zone où on met les flux non physiques, de
    575                 ! réajustement
    576           izone_init=1 ! zone d'initialisation par défaut
    577           option_revap=1
    578           option_tmin=0
    579           izone_revap=2
    580           izone_cond=3
    581           option_cond=1
    582 
    583           ! 1 par défaut pour colorier à la fois condensat LS et
    584           ! condensat convectif. Mais on peut mettre 2 si on ne veut que
    585           ! collorier que le condensat convectif.
    586           call getin('option_cond',option_cond)
    587           write(*,*) 'option_cond=',option_cond
    588 
    589           strtrac(izone_poubelle)='res'
    590           strtrac(izone_cond)='con'
    591           strtrac(izone_revap)='rev'
    592 
    593         elseif (option_traceurs.eq.10) then
    594           ! on trace l'évap venant de ocean/continent no frac/continent frac
    595           !  utilse seulement si couplé avec ORCHIDEE
    596 #ifdef CPP_VEGET
    597 #else
    598           write(*,*) 'iso_traceurs_init 219: option_traceurs=10 ', &
    599      &                      'inutile si on ne couple pas avec ORCHIDEE'
    600           stop
     283         nzone_opt=nzone_temp+1
     284         zone_tempa=-4.0     ! en K
     285         izone_cont=nzone
     286         izone_oce=nzone 
     287         izone_poubelle=nzone
     288         izone_init=nzone    ! zone d'initialisation par defaut
     289         option_revap=0
     290         option_tmin=0 
     291         izone_revap=0
     292         option_cond=0
     293         DO izone=1,nzone_temp
     294            strtrac(izone) = 't'//TRIM(int2str(izone))
     295            WRITE(*,*) 'izone, strtrac=', izone, strtrac(izone)
     296         END DO
     297         strtrac(izone_poubelle)='pou'
     298         ! Initialization of temperatures zones
     299         DO izone=1,nzone_temp-1
     300            zone_temp(izone) = zone_temp1+float(izone-1)            &
     301                            * (zone_tempa*float(izone-nzone_temp+1) &
     302                            + (zone_tempf-zone_temp1)/float(nzone_temp-2))
     303         END DO
     304         WRITE(*,*) 'iso_trac_init 183: zone_temp=', zone_temp
     305      !========================================================================================================================
     306      CASE(5)      !=== TRACING AEJ/MOONSOON FLUX/Harmattan
     307      !========================================================================================================================
     308!        WRITE*,*) 'iso_traceurs_init 129'
     309         nzone_opt=4
     310         izone_cont=1
     311         izone_oce=1
     312         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     313         izone_init=1        ! zone d'initialisation par defaut         
     314         option_revap=0
     315         option_tmin=0
     316         izone_revap=0
     317         izone_aej=2
     318         izone_mousson=3
     319         izone_harmattan=4
     320         option_cond=0
     321         strtrac(izone_poubelle) = 'res'
     322         strtrac(izone_aej)      = 'aej'
     323         strtrac(izone_mousson)  = 'mou'
     324         strtrac(izone_harmattan)= 'sah'
     325      !========================================================================================================================
     326      CASE(6)      !=== TRACING DDFTS
     327      !========================================================================================================================
     328         nzone_opt=2
     329         izone_cont=1
     330         izone_oce=1
     331         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     332         izone_init=1        ! zone d'initialisation par defaut         
     333         option_revap=0
     334         option_tmin=0
     335         izone_revap=0
     336         izone_ddft=2
     337         option_cond=0
     338         strtrac(izone_poubelle)='res'
     339         strtrac(izone_ddft)='dft'
     340      !========================================================================================================================
     341      CASE(9)      !=== TRACING CONDENSATION
     342      !========================================================================================================================
     343         nzone_opt=3
     344         izone_cont=1
     345         izone_oce=1
     346         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     347         izone_init=1        ! zone d'initialisation par defaut         
     348         option_revap=1
     349         option_tmin=0
     350         izone_revap=2
     351         izone_cond=3
     352         option_cond=1
     353         ! 1 par defaut pour colorier a la fois condensat LS et condensat convectif.
     354         ! Mais on peut mettre 2 si on ne veut que colorier que le condensat convectif.
     355         CALL get_in('option_cond',option_cond)
     356         strtrac(izone_poubelle)='res'
     357         strtrac(izone_cond)='con'
     358         strtrac(izone_revap)='rev'
     359      !========================================================================================================================
     360      CASE(10)     !=== TRACING EVAPORATION FROM OCEAN/LAND, NON FRAC/LAND FRAC ; ONLY WHEN COUPLED WITH ORCHIDEE
     361      !========================================================================================================================
     362#ifndef CPP_VEGET
     363         WRITE(*,*) 'iso_traceurs_init 219: option_traceurs=10 inutile si on ne couple pas avec ORCHIDEE'; STOP
    601364#endif         
    602 
    603           ntraceurs_zone_opt=3
    604           izone_cont=1 ! sous-entendu non fractionnant
    605           izone_oce=2
    606           izone_poubelle=2 ! zone où on met les flux non physiques, de
    607                 ! réajustement
    608           izone_init=2 ! zone d'initialisation par défaut
    609           option_revap=0
    610           option_tmin=0
    611           izone_revap=0
    612           izone_contfrac=3
    613           izone_contcanop=3
    614           izone_irrig=0
    615           option_cond=0
    616 
    617           strtrac(izone_oce)='oce'
    618           strtrac(izone_cont)='con' 
    619           strtrac(izone_contfrac)='enu'  ! evap sol nu
    620 
    621         elseif (option_traceurs.eq.11) then
    622           ! on trace reevap des gouttes et le reste
    623 
    624           ntraceurs_zone_opt=2
    625           izone_cont=1
    626           izone_oce=1
    627           izone_poubelle=1 ! zone où on met les flux non physiques, de
    628                 ! réajustement
    629           izone_init=1 ! zone d'initialisation par défaut
    630           option_revap=1
    631           option_tmin=0
    632           izone_revap=2
    633           izone_irrig=0
    634           option_cond=0
    635 
    636           strtrac(izone_poubelle)='res'
    637           strtrac(izone_revap)='rev'
    638 
    639         elseif (option_traceurs.eq.12) then
    640           ! on trace evap du sol nu, evap de la canopée, reste de l'evap cont et
    641           ! evap oce
    642 #ifdef CPP_VEGET
    643 #else
    644           write(*,*) 'iso_traceurs_init 257: option_traceurs=10 ', &
    645      &                      'inutile si on ne couple pas avec ORCHIDEE'
    646           stop
     365         nzone_opt=3
     366         izone_cont=1        ! sous-entendu non fractionnant
     367         izone_oce=2
     368         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     369         izone_init=2        ! zone d'initialisation par defaut
     370         option_revap=0
     371         option_tmin=0
     372         izone_revap=0
     373         izone_contfrac=3
     374         izone_contcanop=3
     375         izone_irrig=0
     376         option_cond=0
     377         strtrac(izone_oce)='oce'
     378         strtrac(izone_cont)='con' 
     379         strtrac(izone_contfrac)='enu'  ! evap sol nu
     380      !========================================================================================================================
     381      CASE(11)     !=== TRACING DROPLETS REEVAPORATION + REST
     382      !========================================================================================================================
     383         nzone_opt=2
     384         izone_cont=1
     385         izone_oce=1
     386         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     387         izone_init=1        ! zone d'initialisation par defaut
     388         option_revap=1
     389         option_tmin=0
     390         izone_revap=2
     391         izone_irrig=0
     392         option_cond=0
     393         strtrac(izone_poubelle)='res'
     394         strtrac(izone_revap)='rev'
     395      !========================================================================================================================
     396      CASE(12)     !=== TRACING NAKED GROUND EVAPORATION, CANOPY EVAPORATION, REST OF LAND EVAPORATION AND OCEAN EVAPORATION
     397      !========================================================================================================================
     398#ifndef CPP_VEGET
     399         WRITE(*,*) 'iso_traceurs_init 257: option_traceurs=10 inutile si on ne couple pas avec ORCHIDEE'; STOP
    647400#endif           
    648 
    649           ntraceurs_zone_opt=2
    650           izone_cont=1
    651           izone_oce=2
    652           izone_poubelle=2 ! zone où on met les flux non physiques, de
    653                 ! réajustement
    654           izone_init=2 ! zone d'initialisation par défaut
    655           option_revap=0
    656           option_tmin=0
    657           izone_revap=0
    658           izone_contfrac=3
    659           izone_contcanop=4
    660           izone_irrig=0   
    661           option_cond=0
    662 
    663           strtrac(izone_oce)='oce'
    664           strtrac(izone_cont)='con'
    665           strtrac(izone_contfrac)='enu'  ! evap sol nu
    666           strtrac(izone_contcanop)='eca'  ! evap canop
    667 
    668        else if (option_traceurs.eq.13) then
    669           ! on trace les température minimales vécues + la revap
    670           ! comme dans article sur LdG
    671            
    672         zone_temp1=293.0         ! en K       
    673 !        parameter (zone_tempf=223.0) ! en K
    674         zone_tempf=243.0 ! en K
    675         zone_tempa=-4.0 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détal en bas
    676 
    677         ! zone 1: >= zone_temp1
    678         ! zone 2 à 4: intermédiaire,
    679         ! zone 5: <zone_tempf
    680        
    681           ntraceurs_zone_opt=nzone_temp+1
    682          
    683           izone_cont=1
    684           izone_oce=1 
    685           izone_poubelle=1
    686           izone_init=1 ! zone d'initialisation par défaut
    687           option_revap=1   
    688           option_tmin=0
    689           izone_revap=ntraceurs_zone
    690           izone_irrig=0
    691           option_cond=0
    692           do izone=1,nzone_temp
    693             write(strz,'(i2.2)') izone
    694             strtrac(izone)='t'//strz
    695             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    696           enddo
    697           strtrac(izone_revap)='rev'
    698 
    699           ! initialisation des zones de tempéarture
    700           do izone=1,nzone_temp-1
    701             zone_temp(izone)=zone_temp1+float(izone-1) &
    702      &                      *(zone_tempa*float(izone-nzone_temp+1) &
    703      &                      +(zone_tempf-zone_temp1)/float(nzone_temp-2))
    704           enddo
    705           write(*,*) 'zone_temp=',zone_temp
    706 
    707        else if (option_traceurs.eq.14) then
    708           ! on trace les pres et lat de dernière saturation définies
    709           ! comme rh>90%
    710            
    711         zone_pres1=600.0*100.0 ! en Pa       
    712         zone_presf=300.0*100.0 ! en Pa
    713         zone_presa=0.0 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détal en bas
    714 
    715         lattag_min=10.0 ! en degrès
    716         dlattag=15.0
    717 
    718         ! zone 1: >= zone_pres1
    719         ! zone 2 à 4: intermédiaire,
    720         ! zone 5: <zone_presf
    721        
    722          ntraceurs_zone_opt=nzone_pres*nzone_lat+1         
    723           izone_cont=ntraceurs_zone
    724           izone_oce=ntraceurs_zone
    725           izone_poubelle=ntraceurs_zone
    726           izone_init=ntraceurs_zone ! zone d'initialisation par défaut
    727           option_revap=0 
    728           option_tmin=0
    729           izone_revap=0
    730           izone_irrig=0
    731           option_cond=0
    732           do izone_pres=1,nzone_pres
    733            do izone_lat=1,nzone_lat
    734             write(strz_pres,'(i1.1)') izone_pres
    735             write(strz_lat,'(i1.1)') izone_lat
    736             strz_preslat=strz_pres//strz_lat
    737             izone=izone_lat+(izone_pres-1)*nzone_lat
    738             strtrac(izone)='t'//strz_preslat
    739             write(*,*) 'izone_pres,izone_lat,strtrac=', &
    740      &                        izone_pres,izone_lat,izone,strtrac(izone)
    741            enddo !do izone_lat=1,nzone_lat
    742           enddo !do izone_pres=1,nzone_pres
    743           strtrac(ntraceurs_zone)='sfc'
    744 
    745           ! initialisation des zones de tempéarture
    746           do izone=1,nzone_pres-1
    747             zone_pres(izone)=zone_pres1+float(izone-1) &
    748      &                      *(zone_presa*float(izone-nzone_pres+1) &
    749      &                      +(zone_presf-zone_pres1)/float(nzone_pres-2))
    750           enddo !do izone=1,nzone_pres-1
    751           write(*,*) 'traceurs_init 332: zone_pres=',zone_pres
    752 !          stop
    753 !
    754        elseif (option_traceurs.eq.15) then
    755           ! on trace l'irrigation dans ORCHIDEE
    756 #ifdef CPP_VEGET
    757 #else
    758           write(*,*) 'iso_traceurs_init 257: option_traceurs=15 ', &
    759      &                      'inutile si on ne couple pas avec ORCHIDEE'
    760           stop
     401         nzone_opt=2
     402         izone_cont=1
     403         izone_oce=2
     404         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     405         izone_init=2        ! zone d'initialisation par defaut
     406         option_revap=0
     407         option_tmin=0
     408         izone_revap=0
     409         izone_contfrac=3
     410         izone_contcanop=4
     411         izone_irrig=0   
     412         option_cond=0
     413         strtrac(izone_oce)='oce'
     414         strtrac(izone_cont)='con'
     415         strtrac(izone_contfrac)='enu' ! evap sol nu
     416         strtrac(izone_contcanop)='eca'! evap canop
     417      !========================================================================================================================
     418      CASE(13)     !=== TRACING MINIMUM EXPERIENCED TEMPERATIRES + REEVAPORATION AS IN THE ARTICLE ON LdG
     419      !========================================================================================================================
     420         zone_temp1=293.0    ! en K       
     421!        zone_tempf=223.0    ! en K
     422         zone_tempf=243.0    ! en K
     423         zone_tempa=-4.0     ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire, <0 pour plus de detal en bas
     424         ! zone 1: >= zone_temp1
     425         ! zone 2 a 4: intermediaire,
     426         ! zone 5: <zone_tempf
     427         nzone_opt=nzone_temp+1
     428         izone_cont=1
     429         izone_oce=1 
     430         izone_poubelle=1
     431         izone_init=1        ! zone d'initialisation par defaut
     432         option_revap=1   
     433         option_tmin=0
     434         izone_revap=nzone
     435         izone_irrig=0
     436         option_cond=0
     437         DO izone=1,nzone_temp
     438            strtrac(izone) = 't'//TRIM(int2str(izone))
     439            WRITE(*,*) 'izone, strtrac = ', izone, strtrac(izone)
     440         END DO
     441         strtrac(izone_revap)='rev'
     442         ! initialisation des zones de tempearture
     443         DO izone=1,nzone_temp-1
     444            zone_temp(izone) = zone_temp1+float(izone-1) &
     445                             *(zone_tempa*float(izone-nzone_temp+1) &
     446                             +(zone_tempf-zone_temp1)/float(nzone_temp-2))
     447         END DO
     448         WRITE(*,*) 'zone_temp=',zone_temp
     449      !========================================================================================================================
     450      CASE(14)     !=== TRACING PRES AND LAT OF LAST SATURATION DEFINED AS rh>90%
     451      !========================================================================================================================
     452         zone_pres1=600.0*100.0   ! en Pa       
     453         zone_presf=300.0*100.0   ! en Pa
     454         zone_presa=0.0           ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire
     455         lattag_min=10.0          ! en degres
     456         dlattag=15.0
     457         ! zone 1: >= zone_pres1
     458         ! zone 2 a 4: intermediaire,
     459         ! zone 5: <zone_presf
     460         nzone_opt=nzone_pres*nzone_lat+1         
     461         izone_cont=nzone
     462         izone_oce=nzone
     463         izone_poubelle=nzone
     464         izone_init=nzone         ! zone d'initialisation par defaut
     465         option_revap=0 
     466         option_tmin=0
     467         izone_revap=0
     468         izone_irrig=0
     469         option_cond=0
     470         DO izone_pres=1,nzone_pres
     471            DO izone_lat=1,nzone_lat
     472               izone=izone_lat+(izone_pres-1)*nzone_lat
     473               strtrac(izone) = 't'//TRIM(int2str(izone_pres))//TRIM(int2str(izone_lat))
     474               write(*,*) 'izone_pres, izone_lat, izone, strtrac = ',izone_pres, izone_lat, izone, strtrac(izone)
     475            END DO
     476         END DO
     477         strtrac(nzone)='sfc'
     478         ! initialisation des zones de temperature
     479         DO izone=1,nzone_pres-1
     480            zone_pres(izone) = zone_pres1+float(izone-1) &
     481                             *(zone_presa*float(izone-nzone_pres+1) &
     482                             +(zone_presf-zone_pres1)/float(nzone_pres-2))
     483         END DO
     484         WRITE(*,*) 'traceurs_init 332: zone_pres=',zone_pres
     485      !========================================================================================================================
     486      CASE(15)     !=== TRACING IRRIGATION IN ORCHIDEE
     487      !========================================================================================================================
     488#ifndef CPP_VEGET
     489         WRITE(*,*) 'iso_traceurs_init 257: option_traceurs=15 inutile si on ne couple pas avec ORCHIDEE'; STOP
    761490#endif
    762 
    763           ntraceurs_zone_opt=1
    764           izone_cont=1
    765           izone_oce=1
    766           izone_poubelle=1 ! zone où on met les flux non physiques, de
    767                 ! réajustement
    768           izone_init=1 ! zone d'initialisation par défaut
    769           option_revap=0
    770           option_tmin=0
    771           izone_revap=0
    772           izone_contfrac=0
    773           izone_contcanop=0
    774           izone_irrig=2
    775           option_cond=0
    776          
    777           strtrac(izone_poubelle)='res'
    778           strtrac(izone_irrig)='irrig'
    779 
    780           ! dans ce cas particulier, il y a des traceurs dans ORCHIDEE
    781           ntracisoOR=ntraciso
    782 
    783         else if ((option_traceurs.eq.17).or. &
    784      &           (option_traceurs.eq.18)) then
    785           ! on trace les température minimales vécues
    786           ! comme dans article sur LdG sauf pas de revap
    787            
    788         zone_temp1=12.0e-3 ! en kg/kg       
    789         zone_tempf=0.2e-3 ! en kg/kg
    790         zone_tempa=1.2e-3 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détail en bas
    791 
    792 !       parameter (zone_temp1=14.0e-3) ! en kg/kg       
    793 !       parameter (zone_tempf=0.2e-3) ! en kg/kg
    794 !       parameter (zone_tempa=0.5e-3)       
    795 
    796 !        parameter (zone_temp1=10.0e-3) ! en kg/kg
    797 !       parameter (zone_tempf=0.5e-3) ! en kg/kg
    798 !       parameter (zone_tempa=0.5e-3)
    799 
    800         ! zone 1: >= zone_temp1
    801         ! zone 2 à 4: intermédiaire,
    802         ! zone 5: <zone_tempf
    803        
    804         ntraceurs_zone_opt=nzone_temp+3
    805        
    806           izone_cont=nzone_temp+1
    807           izone_oce=nzone_temp+1
    808           izone_poubelle=nzone_temp+1
    809           izone_init=nzone_temp+1 ! zone d'initialisation par défaut
    810           option_revap=1 
    811           option_tmin=1
    812           option_cond=1
    813 
    814           izone_revap=nzone_temp+3
    815           izone_cond=nzone_temp+2
    816           do izone=1,nzone_temp
    817             write(strz,'(i2.2)') izone
    818             strtrac(izone)='t'//strz
    819             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    820           enddo !do izone=1,nzone_temp
    821           strtrac(izone_poubelle)='sfc'
    822           strtrac(izone_cond)='con'
    823           strtrac(izone_revap)='rev'
    824 
    825           ! initialisation des zones de tempéarture
    826           do izone=1,nzone_temp-1
    827             zone_temp(izone)=zone_temp1+float(izone-1) &
    828      &                      *(zone_tempa*float(izone-nzone_temp+1) &
    829      &             +(zone_tempf-zone_temp1)/float(nzone_temp-2))
    830           enddo
    831          write(*,*) 'zone_temp1,zone_tempf,zone_tempa=', &
    832      &              zone_temp1,zone_tempf,zone_tempa
    833           write(*,*) 'zone_temp=',zone_temp
    834 !          stop         
    835 
    836         else if (option_traceurs.eq.19) then
    837 
    838         zone_temp1=12.0e-3 ! en kg/kg       
    839         zone_tempf=0.2e-3 ! en kg/kg
    840         zone_tempa=1.2e-3 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détail en bas
    841 
    842 !       parameter (zone_temp1=14.0e-3) ! en kg/kg       
    843 !       parameter (zone_tempf=0.2e-3) ! en kg/kg
    844 !       parameter (zone_tempa=0.5e-3)       
    845 
    846 !        parameter (zone_temp1=10.0e-3) ! en kg/kg
    847 !       parameter (zone_tempf=0.5e-3) ! en kg/kg
    848 !       parameter (zone_tempa=0.5e-3)
    849 
    850         ! zone 1: >= zone_temp1
    851         ! zone 2 à 4: intermédiaire,
    852         ! zone 5: <zone_tempf
    853        
    854         ntraceurs_zone_opt=nzone_temp+4
    855        
    856           izone_cont=nzone_temp+1
    857           izone_oce=nzone_temp+1
    858           izone_poubelle=nzone_temp+1
    859           if (option_seuil_tag_tmin.eq.1) then
    860             izone_init=nzone_temp+1 ! zone d'initialisation par défaut
    861           else
     491         nzone_opt=1
     492         izone_cont=1
     493         izone_oce=1
     494         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     495         izone_init=1        ! zone d'initialisation par defaut
     496         option_revap=0
     497         option_tmin=0
     498         izone_revap=0
     499         izone_contfrac=0
     500         izone_contcanop=0
     501         izone_irrig=2
     502         option_cond=0
     503         strtrac(izone_poubelle)='res'
     504         strtrac(izone_irrig)='irrig'
     505         ! dans ce cas particulier, il y a des traceurs dans ORCHIDEE
     506         ntracisoOR=ntiso
     507      !========================================================================================================================
     508      CASE(17,18)  !=== TRACING MINIMAL EXPERIENCES TEMPERATURES AS IN THE ARTICLE ABOUT LdG, BUT NO EVAPORATION
     509      !========================================================================================================================
     510         zone_temp1=12.0e-3  ! en kg/kg       
     511         zone_tempf=0.2e-3   ! en kg/kg
     512         zone_tempa=1.2e-3   ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire
     513!        zone_temp1=14.0e-3  ! en kg/kg       
     514!        zone_tempf=0.2e-3   ! en kg/kg
     515!        zone_tempa=0.5e-3       
     516!        zone_temp1=10.0e-3  ! en kg/kg
     517!        zone_tempf=0.5e-3   ! en kg/kg
     518!        zone_tempa=0.5e-3
     519         ! zone 1: >= zone_temp1
     520         ! zone 2 a 4: intermediaire,
     521         ! zone 5: <zone_tempf
     522         nzone_opt=nzone_temp+3
     523         izone_cont=nzone_temp+1
     524         izone_oce=nzone_temp+1
     525         izone_poubelle=nzone_temp+1
     526         izone_init=nzone_temp+1 ! zone d'initialisation par defaut
     527         option_revap=1 
     528         option_tmin=1
     529         option_cond=1
     530         izone_revap=nzone_temp+3
     531         izone_cond=nzone_temp+2
     532         DO izone=1,nzone_temp
     533            strtrac(izone) = 't'//TRIM(int2str(izone))
     534            WRITE(*,*) 'izone, strtrac = ', izone, strtrac(izone)
     535         END DO !do izone=1,nzone_temp
     536         strtrac(izone_poubelle)='sfc'
     537         strtrac(izone_cond)='con'
     538         strtrac(izone_revap)='rev'
     539         ! initialisation des zones de tempearture
     540         DO izone=1,nzone_temp-1
     541            zone_temp(izone) = zone_temp1+float(izone-1) &
     542                             *(zone_tempa*float(izone-nzone_temp+1) &
     543                             +(zone_tempf-zone_temp1)/float(nzone_temp-2))
     544         END DO
     545         WRITE(*,*) 'zone_temp1,zone_tempf,zone_tempa=',zone_temp1,zone_tempf,zone_tempa
     546         WRITE(*,*) 'zone_temp=',zone_temp
     547!        STOP         
     548      !========================================================================================================================
     549      CASE(19)     !=== TRACING TROPICAL AND EXTRATROPICAL VAPOUR
     550      !========================================================================================================================
     551         zone_temp1=12.0e-3  ! en kg/kg       
     552         zone_tempf=0.2e-3   ! en kg/kg
     553         zone_tempa=1.2e-3   ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire, <0 pour plus de detail en bas
     554!        zone_temp1=14.0e-3  ! en kg/kg       
     555!        zone_tempf=0.2e-3   ! en kg/kg
     556!        zone_tempa=0.5e-3
     557!        zone_temp1=10.0e-3  ! en kg/kg       
     558!        zone_tempf=0.5e-3   ! en kg/kg
     559!        zone_tempa=0.5e-3
     560         ! zone 1: >= zone_temp1
     561         ! zone 2 a 4: intermediaire,
     562         ! zone 5: <zone_tempf
     563         nzone_opt=nzone_temp+4
     564         izone_cont=nzone_temp+1
     565         izone_oce=nzone_temp+1
     566         izone_poubelle=nzone_temp+1
     567         IF(option_seuil_tag_tmin == 1) THEN
     568            izone_init=nzone_temp+1 ! zone d'initialisation par defaut
     569         ELSE
    862570            izone_init=nzone_temp
    863           endif
    864           option_revap=1   
    865           izone_revap=nzone_temp+3
    866           izone_cond=nzone_temp+2
    867           izone_ddft=nzone_temp+4
    868           option_tmin=1         
    869           option_cond=1
    870           do izone=1,nzone_temp
    871             write(strz,'(i2.2)') izone
    872             strtrac(izone)='t'//strz
    873             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    874           enddo !do izone=1,nzone_temp
    875           strtrac(izone_poubelle)='sfc'
    876           strtrac(izone_cond)='con'
    877           strtrac(izone_revap)='rev'
    878           strtrac(izone_ddft)='dft'
    879 
    880         elseif (option_traceurs.eq.20) then
    881           ! on vapeur tropical/extractropicale/recyclage extractropical
    882           ! pour comprendre controles humidité et isotopes subtropicaux.       
    883          
    884           lim_tag20=35.0
    885           call getin('lim_tag20',lim_tag20)
    886           write(*,*) 'lim_tag20=',lim_tag20
    887 
    888           ntraceurs_zone_opt=3
    889           izone_cont=1
    890           izone_oce=1
    891           izone_poubelle=2 ! zone où on met les flux non physiques, de
    892                 ! réajustement
    893           izone_init=2 ! zone d'initialisation par défaut
    894           option_revap=0
    895           option_tmin=0
    896           izone_revap=0
    897           izone_trop=2
    898           izone_extra=3
    899 
    900           strtrac(izone_trop)='tro' ! vapeur tropicale
    901           strtrac(izone_extra)='ext' ! vapeur extractropicale evaporée
    902                 ! dans les tropiques
    903           strtrac(izone_cont)='rec' ! recyclage
    904 
    905         elseif (option_traceurs.eq.21) then
    906           ! on trace 2 boites 3D: UT tropicale et extratropiques
    907           ! fonctionnement similaire à option 5 pour taggage des zones
    908           ! AMMA
    909 !          write(*,*) 'iso_traceurs_init 129'
    910 
    911           ntraceurs_zone_opt=3
    912           izone_cont=1
    913           izone_oce=1
    914           izone_poubelle=1 ! zone où on met les flux non physiques, de
    915                 ! réajustement
    916           izone_init=1 ! zone d'initialisation par défaut
    917           option_revap=0
    918           option_tmin=0
    919           izone_revap=0
    920           izone_trop=2
    921           izone_extra=3
    922           option_cond=0
    923 
    924           strtrac(izone_poubelle)='res'
    925           strtrac(izone_trop)='tro'
    926           strtrac(izone_extra)='ext'
    927 
    928         elseif (option_traceurs.eq.22) then
    929           ! on trace la vapeur qui a été processée dans zones de
    930           ! convections à 3 niveaux: BT, MT et UT
    931 
    932           lim_precip_tag22=20.0
    933           call getin('lim_precip_tag22',lim_precip_tag22)
    934           write(*,*) 'lim_precip_tag22=',lim_precip_tag22
    935 
    936           ntraceurs_zone_opt=3
    937           izone_cont=1
    938           izone_oce=1
    939           izone_poubelle=1 ! zone où on met les flux non physiques, de
    940                 ! réajustement
    941           izone_init=1 ! zone d'initialisation par défaut
    942           option_revap=0
    943           option_tmin=0
    944           izone_revap=0
    945           izone_conv_BT=2
    946           izone_conv_UT=3
    947           option_cond=0
    948 
    949           strtrac(izone_poubelle)='res'
    950           strtrac(izone_conv_BT)='cbt'
    951           strtrac(izone_conv_UT)='cut'
    952 
    953         else
    954             write(*,*) 'traceurs_init 36: option pas encore prévue'
    955             stop
    956         endif
    957 
    958        
    959           if (ntraceurs_zone_opt.ne.ntraceurs_zone) then
    960                 write(*,*) 'ntraceurs_zone_opt,ntraceurs_zone=', &
    961                         & ntraceurs_zone_opt,ntraceurs_zone
    962                 call abort_physic ('isotrac_mod','ntraceurs_zone incoherent',1)
    963           endif
    964 
    965        
    966         ! seuil sur le taux de condensation
    967         if (option_tmin.eq.1) then
    968           seuil_tag_tmin=0.01
    969           call getin('seuil_tag_tmin',seuil_tag_tmin)
    970           write(*,*) 'seuil_tag_tmin=',seuil_tag_tmin
    971 
    972           seuil_tag_tmin_ls=seuil_tag_tmin
    973           call getin('seuil_tag_tmin_ls',seuil_tag_tmin_ls)
    974           write(*,*) 'seuil_tag_tmin_ls=',seuil_tag_tmin_ls
    975 
    976           option_seuil_tag_tmin=1
    977           call getin('option_seuil_tag_tmin',option_seuil_tag_tmin)
    978           write(*,*) 'option_seuil_tag_tmin=',option_seuil_tag_tmin
    979         endif
    980 
    981 
    982         do ixt=1,niso
    983            index_zone(ixt)=0
    984            index_iso(ixt)=ixt
    985         enddo
    986         itrac=niso       
    987         do izone=1,ntraceurs_zone
    988           do ixt=1,niso
    989             itrac=itrac+1
    990             index_zone(itrac)=izone
    991             index_iso(itrac)=ixt
    992             index_trac_loc(izone,ixt)=itrac
    993             if (index_trac(izone,ixt).ne.index_trac_loc(izone,ixt)) then
    994                 write(*,*) 'isotrac 989: izone,ixt,itrac=',izone,ixt,itrac
    995                 CALL abort_physic ('isotrac','isotrac 989',1)
    996             endif
    997           enddo
    998         enddo
     571         END IF
     572         option_revap=1   
     573         izone_revap=nzone_temp+3
     574         izone_cond=nzone_temp+2
     575         izone_ddft=nzone_temp+4
     576         option_tmin=1         
     577         option_cond=1
     578         DO izone=1,nzone_temp
     579            strtrac(izone) = 't'//TRIM(int2str(izone))
     580            WRITE(*,*) 'izone, strtrac = ', izone, strtrac(izone)
     581         END DO
     582         strtrac(izone_poubelle)='sfc'
     583         strtrac(izone_cond)='con'
     584         strtrac(izone_revap)='rev'
     585         strtrac(izone_ddft)='dft'
     586      !========================================================================================================================
     587      CASE(20)     !=== TRACING TROPICAL/EXTRATROPICAL/EXTRATROPICAL RECYCLING TO STUDY HUMIDITY AND SUBTROPICAL ISOTOPES CONTROL
     588      !========================================================================================================================
     589         CALL get_in('lim_tag20', lim_tag20, 35.0)
     590         nzone_opt=3
     591         izone_cont=1
     592         izone_oce=1
     593         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     594         izone_init=2        ! zone d'initialisation par defaut
     595         option_revap=0
     596         option_tmin=0
     597         izone_revap=0
     598         izone_trop=2
     599         izone_extra=3
     600         strtrac(izone_trop)='tro'     ! tropical vapour
     601         strtrac(izone_extra)='ext'    ! extratropical vapour evaporated in the tropics
     602         strtrac(izone_cont)='rec'     ! recycling
     603      !========================================================================================================================
     604      CASE(21)     !=== TRACING TWO 3D BOXES: TROPICAL UT AND EXTRATROPICS ; SIMILAR TO 5 FOR AMMA ZONES TAGGING
     605      !========================================================================================================================
     606!        WRITE(*,*) 'iso_traceurs_init 129'
     607         nzone_opt=3
     608         izone_cont=1
     609         izone_oce=1
     610         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     611         izone_init=1        ! zone d'initialisation par defaut
     612         option_revap=0
     613         option_tmin=0
     614         izone_revap=0
     615         izone_trop=2
     616         izone_extra=3
     617         option_cond=0
     618         strtrac(izone_poubelle)='res'
     619         strtrac(izone_trop)='tro'
     620         strtrac(izone_extra)='ext'
     621      !========================================================================================================================
     622      CASE(22)     !=== TRACING WATER VAPOUR PROCESSED IN THE 3-LEVELS SCONVECTION ZONES BT, MT AND UT
     623      !========================================================================================================================
     624         CALL get_in('lim_precip_tag22', lim_precip_tag22, 20.0)
     625         nzone_opt=3
     626         izone_cont=1
     627         izone_oce=1
     628         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     629         izone_init=1        ! zone d'initialisation par defaut
     630         option_revap=0
     631         option_tmin=0
     632         izone_revap=0
     633         izone_conv_BT=2
     634         izone_conv_UT=3
     635         option_cond=0
     636         strtrac(izone_poubelle)='res'
     637         strtrac(izone_conv_BT)='cbt'
     638         strtrac(izone_conv_UT)='cut'
     639      CASE DEFAULT
     640         WRITE(*,*) 'traceurs_init 36: option pas encore prevue' ; STOP
     641   END SELECT
     642
     643   IF(nzone_opt /= nzone) THEN
     644      WRITE(*,*) 'nzone_opt, nzone=', nzone_opt, nzone
     645      CALL abort_physic ('isotrac_mod','nzone incoherent',1)
     646   END IF
     647
     648   !--- Condensation rate threshold
     649   IF(option_tmin == 1) THEN
     650      seuil_tag_tmin = 0.01
     651      CALL get_in('seuil_tag_tmin',        seuil_tag_tmin,        0.01)
     652      CALL get_in('seuil_tag_tmin_ls',     seuil_tag_tmin_ls,     seuil_tag_tmin)
     653      CALL get_in('option_seuil_tag_tmin', option_seuil_tag_tmin, 1)
     654   END IF
     655   DO ixt=1,niso
     656      index_zone(ixt)=0
     657      index_iso(ixt)=ixt
     658   END DO
     659
     660   index_zone = [(INDEX(isoZone, strTail(         isoName(ixt) ,'_')), ixt=1, ntiso)]
     661   index_iso  = [(INDEX(isoName, strHead(delPhase(isoName(ixt)),'_')), ixt=1, ntiso)]
     662   itZonIso_loc = itZonIso(:,:)
    999663#ifdef ISOVERIF
    1000 !        call iso_verif_egalite(float(itrac),float(ntraciso), &
    1001 !     &           'traceurs_init 50')
    1002         if (itrac.ne.ntraciso) then
    1003           write(*,*) 'traceurs_init 50'
    1004           stop
    1005         endif
    1006      
    1007         write(*,*) 'traceurs_init 65: bilan de l''init:'
    1008         write(*,*) 'index_zone=',index_zone(1:ntraciso)
    1009         write(*,*) 'index_iso=',index_iso(1:ntraciso)
    1010         write(*,*) 'index_trac=',index_trac(1:ntraceurs_zone,1:niso)
    1011         do izone=1,ntraceurs_zone
    1012           write(*,*) 'strtrac(',izone,')=',strtrac(izone)
    1013         enddo !do izone=1,ntraceurs_zone
    1014         write(*,*) 'ntracisoOR=',ntracisoOR
     664   WRITE(*,*) 'traceurs_init 65: bilan de l''init:'
     665   WRITE(*,*) 'index_zone = '//TRIM(strStack(int2str(index_zone(1:ntiso))))
     666   WRITE(*,*) 'index_iso  = '//TRIM(strStack(int2str(index_iso (1:ntiso))))
     667   DO izone=1,nzone
     668      WRITE(*,*)'itZonIso('//TRIM(int2str(izone))//',:) = '//strStack(int2str(itZonIso(izone,:)))
     669   END DO
     670   DO izone=1,nzone
     671      WRITE(*,*)'strtrac('//TRIM(int2str(izone))//',:) = '//TRIM(strtrac(izone))
     672   END DO
     673   WRITE(*,*) 'ntracisoOR=',ntracisoOR
    1015674#endif 
    1016675
    1017         end subroutine iso_traceurs_init
    1018 
     676END SUBROUTINE iso_traceurs_init
    1019677
    1020678END MODULE isotrac_mod

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/isotrac_routines_mod.F90

    r3927 r4368  
    88! isotopes_verif a besoin de isotopes et isotrac
    99! isotrac n'a besoin que de isotopes
     10    USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, index_trac=>itZonIso, ntraceurs_zone=>nzone
    1011IMPLICIT NONE
    1112
    … …  
    1718     &           ncum,izone)
    1819
    19     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    2020    USE isotopes_mod, ONLY: ridicule,iso_eau
    2121
    … …  
    6363     &          xtp_avantevap_cas,liq,hdiag)
    6464
    65     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    6665    USE isotopes_mod, ONLY: ridicule,iso_eau,iso_HDO,ridicule_evap
    6766    USE isotrac_mod, only: option_revap,evap_franche,izone_revap, &
    … …  
    231230     &    nloc,ncum,nd,i,izone)
    232231
    233     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    234232    USE isotopes_mod, ONLY: iso_eau
    235233#ifdef ISOVERIF       
    … …  
    320318     &    nloc,ncum,nd,i,izone)
    321319
    322     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    323320    USE isotopes_mod, ONLY: iso_eau
    324321#ifdef ISOVERIF
    … …  
    408405     &    nloc,ncum,nd,i,izone)
    409406
    410     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    411407    USE isotopes_mod, ONLY: ridicule,iso_eau
    412408#ifdef ISOVERIF
    … …  
    476472     &    nloc,ncum,nd,izone)
    477473
    478     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    479474    USE isotopes_mod, ONLY: ridicule,iso_eau
    480475#ifdef ISOVERIF
    … …  
    643638     &    nloc,ncum,nd,i,frac_sublim,izone)
    644639
    645     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    646640    USE isotopes_mod, ONLY: ridicule,iso_eau
    647641#ifdef ISOVERIF
    … …  
    802796     &       xtrevap_tag,liq,hdiag)
    803797
    804     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    805798    USE isotopes_mod, ONLY: ridicule,iso_eau
    806799    USE isotrac_mod, only: option_revap,evap_franche
    … …  
    899892     &       klon,izone,ptrac)
    900893
    901     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    902894    USE isotopes_mod, ONLY: ridicule,iso_eau
    903895#ifdef ISOVERIF
    … …  
    986978     &       klon,izone)
    987979
    988     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    989980    USE isotopes_mod, ONLY: ridicule,iso_eau
    990981#ifdef ISOVERIF
    … …  
    10521043     &    klon,izone,zxt,xtrevap_tag)
    10531044
    1054 USE infotrac_phy, ONLY: ntraciso,niso, &
    1055         ntraceurs_zone,index_trac
    10561045#ifdef ISOVERIF
    10571046USE isotopes_verif_mod
    … …  
    11241113      USE isotrac_mod, only: use_bassin_atlantic,use_bassin_medit, &
    11251114&       use_bassin_indian,use_bassin_austral,use_bassin_pacific, &
    1126 &       use_bassin_merarabie,use_bassin_golfebengale,use_bassin_indiansud, &
    1127 &       use_bassin_tropics,use_bassin_midlats,use_bassin_hauteslats, &
     1115&       use_bassin_MerArabie,use_bassin_BengalGolf,use_bassin_SouthIndian, &
     1116&       use_bassin_tropics,use_bassin_midlats,use_bassin_HighLats, &
    11281117&       bassin_atlantic,bassin_medit, &
    11291118&       bassin_indian,bassin_austral,bassin_pacific, &
    1130 &       bassin_merarabie,bassin_golfebengale,bassin_indiansud, &
    1131 &       bassin_tropics,bassin_midlats,bassin_hauteslats
     1119&       bassin_MerArabie,bassin_BengalGolf,bassin_SouthIndian, &
     1120&       bassin_tropics,bassin_midlats,bassin_HighLats
    11321121      implicit none
    11331122      ! répond true si lat,lon se trouve dans le bassin numéroté bassin
    … …  
    11481137      write(*,*) 'is_in_basin 84: entree,bassin=',bassin
    11491138#endif
    1150       if ((use_bassin_atlantic.eq.1).and. &
    1151      &           (bassin.eq.bassin_atlantic)) then
     1139      if (use_bassin_atlantic .and. bassin==bassin_atlantic) then
    11521140#ifdef ISOVERIF           
    11531141          write(*,*) 'bassin Atlantique?'
    … …  
    11801168          endif
    11811169
    1182       else if ((use_bassin_medit.eq.1).and. &
    1183      &           (bassin.eq.bassin_medit)) then
     1170      else if (use_bassin_medit .and. bassin==bassin_medit) then
    11841171#ifdef ISOVERIF           
    11851172          write(*,*) 'bassin Medit?'
    … …  
    11941181          endif
    11951182
    1196       else if ((use_bassin_indian.eq.1).and. &
    1197      &           (bassin.eq.bassin_indian)) then
     1183      else if (use_bassin_indian .and. bassin==bassin_indian) then
    11981184#ifdef ISOVERIF           
    11991185          write(*,*) 'bassin indian?'
    … …  
    12101196          endif   
    12111197
    1212       else if ((use_bassin_indiansud.eq.1).and. &
    1213      &           (bassin.eq.bassin_indiansud)) then
     1198      else if (use_bassin_SouthIndian .and. bassin==bassin_SouthIndian) then
    12141199#ifdef ISOVERIF           
    12151200          write(*,*) 'bassin indian hemisphere Sud?'
    … …  
    12201205          endif
    12211206         
    1222       else if ((use_bassin_merarabie.eq.1).and. &
    1223      &           (bassin.eq.bassin_merarabie)) then
     1207      else if (use_bassin_MerArabie .and. bassin==bassin_MerArabie) then
    12241208#ifdef ISOVERIF           
    12251209          write(*,*) 'bassin Mer d''Arabie?'
    … …  
    12301214          endif
    12311215
    1232       else if ((use_bassin_golfebengale.eq.1).and. &
    1233      &           (bassin.eq.bassin_golfebengale)) then
     1216      else if (use_bassin_BengalGolf .and. bassin==bassin_BengalGolf) then
    12341217#ifdef ISOVERIF           
    12351218          write(*,*) 'bassin Golfe du Bengale?'
    … …  
    12401223          endif         
    12411224
    1242       else if ((use_bassin_pacific.eq.1).and. &
    1243      &           (bassin.eq.bassin_pacific)) then
     1225      else if (use_bassin_pacific .and. bassin==bassin_pacific) then
    12441226#ifdef ISOVERIF           
    12451227          write(*,*) 'bassin Pacific?'
    … …  
    12781260          endif
    12791261
    1280       else if ((use_bassin_austral.eq.1).and. &
    1281      &           (bassin.eq.bassin_austral)) then 
     1262      else if (use_bassin_austral .and. bassin==bassin_austral) then 
    12821263#ifdef ISOVERIF           
    12831264          write(*,*) 'bassin austral?'
    … …  
    12881269          endif 
    12891270
    1290       else if ((use_bassin_hauteslats.eq.1).and. &
    1291      &           (bassin.eq.bassin_hauteslats)) then 
     1271      else if (use_bassin_HighLats .and. bassin==bassin_HighLats) then 
    12921272#ifdef ISOVERIF           
    12931273          write(*,*) 'bassin hautes lats?'
    … …  
    12981278          endif
    12991279
    1300       else if ((use_bassin_tropics.eq.1).and. &
    1301      &           (bassin.eq.bassin_tropics)) then 
     1280      else if (use_bassin_tropics .and. bassin==bassin_tropics) then 
    13021281#ifdef ISOVERIF           
    13031282          write(*,*) 'bassin tropics?'
    … …  
    13081287          endif
    13091288
    1310        else if ((use_bassin_midlats.eq.1).and. &
    1311      &           (bassin.eq.bassin_midlats)) then 
     1289       else if (use_bassin_midlats .and. bassin==bassin_midlats) then 
    13121290#ifdef ISOVERIF           
    13131291          write(*,*) 'bassin mid lats?'
    … …  
    13251303          write(*,*) 'bassin_indian=' ,bassin_indian
    13261304          write(*,*) 'bassin_austral=' ,bassin_austral
    1327           write(*,*) 'bassin_merarabie=' ,bassin_merarabie
    1328           write(*,*) 'bassin_golfebengale=' ,bassin_golfebengale
    1329           write(*,*) 'bassin_indiansud=' ,bassin_indiansud
     1305          write(*,*) 'bassin_MerArabie=' ,bassin_MerArabie
     1306          write(*,*) 'bassin_BengalGolf=' ,bassin_BengalGolf
     1307          write(*,*) 'bassin_SouthIndian=' ,bassin_SouthIndian
    13301308          write(*,*) 'use_bassin_atlantic=' ,use_bassin_atlantic 
    13311309          write(*,*) 'use_bassin_medit=' ,use_bassin_medit
    13321310          write(*,*) 'use_bassin_indian=' ,use_bassin_indian
    13331311          write(*,*) 'use_bassin_austral=' ,use_bassin_austral
    1334           write(*,*) 'use_bassin_merarabie=' ,use_bassin_merarabie
    1335           write(*,*) 'use_bassin_golfebengale=' ,use_bassin_golfebengale
    1336           write(*,*) 'use_bassin_indiansud=' ,use_bassin_indiansud
     1312          write(*,*) 'use_bassin_MerArabie=' ,use_bassin_MerArabie
     1313          write(*,*) 'use_bassin_BengalGolf=' ,use_bassin_BengalGolf
     1314          write(*,*) 'use_bassin_SouthIndian=' ,use_bassin_SouthIndian
    13371315          stop
    13381316      endif
    … …  
    13421320
    13431321      subroutine find_bassin(lat,lon,bassin)
    1344       use isotrac_mod, only: izone_poubelle,ntraceurs_zone,option_traceurs, &
     1322      use isotrac_mod, only: izone_poubelle,ntraceurs_zone=>ntiso,option_traceurs, &
    13451323&        bassin_map
    13461324#ifdef ISOVERIF
    … …  
    15171495        subroutine isotrac_recolorise_tmin(xt,t)
    15181496        USE dimphy, only: klon, klev
    1519         USE infotrac_phy, ONLY: ntraciso,niso, &
    1520         ntraceurs_zone,index_trac
    15211497        USE isotrac_mod, only: zone_temp,nzone_temp
    15221498#ifdef ISOVERIF
    … …  
    16031579        subroutine isotrac_recolorise_tmin_sfrev(xt,t)
    16041580        USE dimphy, only: klon,klev
    1605         USE infotrac_phy, ONLY: ntraciso,niso, &
    1606         ntraceurs_zone,index_trac
    16071581        USE isotrac_mod, only: nzone_temp,zone_temp
    16081582#ifdef ISOVERIF
    … …  
    16611635        subroutine isotrac_recolorise_saturation(xt,rh,lat,pres)
    16621636        USE dimphy, only: klon,klev
    1663         USE infotrac_phy, ONLY: ntraciso,niso, &
    1664         ntraceurs_zone,index_trac
    16651637#ifdef ISOVERIF
    16661638        USE isotopes_verif_mod
    … …  
    17271699        subroutine isotrac_recolorise_boite(xt,boite_map)
    17281700        USE dimphy, only: klon,klev
    1729         USE infotrac_phy, ONLY: ntraciso,niso, &
    1730         ntraceurs_zone,index_trac
    17311701#ifdef ISOVERIF
    17321702        USE isotopes_verif_mod
    … …  
    17811751        subroutine isotrac_recolorise_extra(xt,rlat)
    17821752        USE dimphy, only: klon,klev
    1783         USE infotrac_phy, ONLY: ntraciso,niso, &
    1784         ntraceurs_zone,index_trac
    17851753        usE isotrac_mod, only: lim_tag20,izone_trop,izone_extra
    17861754#ifdef ISOVERIF
    … …  
    18301798        subroutine isotrac_recolorise_conv(xt,rlat,presnivs,rain_con)
    18311799        USE dimphy, only: klon,klev
    1832         USE infotrac_phy, ONLY: ntraciso,niso, &
    1833         ntraceurs_zone,index_trac
    18341800        use isotrac_mod, only: lim_precip_tag22, &
    18351801&       izone_conv_BT,izone_conv_UT
    … …  
    19021868        subroutine boite_AMMA_init(lat,lon,presnivs,boite_map)
    19031869        USE dimphy, only: klon,klev
    1904         USE infotrac_phy, ONLY: ntraciso,niso, &
    1905         ntraceurs_zone,index_trac
    19061870#ifdef ISOVERIF
    19071871        USE isotopes_verif_mod
    … …  
    19571921        subroutine boite_UT_extra_init(lat,lon,presnivs,boite_map)
    19581922        USE dimphy, only: klon,klev
    1959         USE infotrac_phy, ONLY: ntraciso,niso, &
    1960         ntraceurs_zone,index_trac
    19611923        use isotrac_mod, only: izone_extra,izone_trop
    19621924#ifdef ISOVERIF
    … …  
    20952057     &           seuil_in)
    20962058        USE dimphy, only: klon,klev
    2097         USE infotrac_phy, ONLY: ntraciso,niso, &
    2098         ntraceurs_zone,index_trac
    20992059        USE isotopes_mod, only: bidouille_anti_divergence,iso_eau
    21002060        use isotrac_mod, only: option_seuil_tag_tmin,izone_cond, &
    … …  
    23042264        subroutine bassin_map_init_opt20(lat,bassin_map)
    23052265        USE dimphy, only: klon
    2306         USE infotrac_phy, ONLY: ntraciso,niso, &
    2307         ntraceurs_zone,index_trac
    23082266        use isotrac_mod, only: izone_cont,izone_trop,lim_tag20
    23092267#ifdef ISOVERIF
    … …  
    23342292        USE geometry_mod, ONLY : latitude_deg
    23352293        USE dimphy, only: klon,klev
    2336         use infotrac_phy, only: ntraciso
    23372294        use isotrac_mod, only: option_traceurs,boite_map
    23382295        implicit none
    … …  
    23652322        subroutine iso_verif_traceur_jbid_vect(x,n,m)
    23662323        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2367         USE infotrac_phy, ONLY: index_trac,niso,ntraciso
    2368         use isotrac_mod, only: ntraceurs_zone
     2324        !use isotrac_mod, only: ntraceurs_zone=>nzone
     2325        USE infotrac_phy, ONLY: ntraceurs_zone=>nzone
    23692326        implicit none
    23702327       
    … …  
    24302387        subroutine iso_verif_traceur_jbidouille(x)
    24312388        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2432         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    24332389        implicit none
    24342390       
    … …  
    24702426        subroutine iso_verif_traceur_jbid_pos(x)
    24712427        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2472         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    24732428!#ifdef ISOVERIF
    24742429!        use isotopes_verif_mod, only: iso_verif_traceur_pbidouille
    … …  
    25442499        subroutine iso_verif_traceur_jbid_pos_vect(n,m,x)
    25452500        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2546         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    25472501#ifdef ISOVERIF
    25482502        USE isotopes_verif_mod
    … …  
    26252579        subroutine iso_verif_traceur_jbid_pos2(x,q)
    26262580        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2627         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    26282581#ifdef ISOVERIF
    26292582        use isotopes_verif_mod
    … …  
    26962649        subroutine iso_verif_traceur_jbid_vect1D(x,n)
    26972650        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2698         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    26992651        implicit none
    27002652       
    … …  
    27392691
    27402692        subroutine iso_verif_traceur_pbidouille(x,err_msg)
    2741         USE infotrac_phy, ONLY: ntraciso
    27422693        use isotopes_verif_mod
    27432694        implicit none
    … …  
    27652716
    27662717        function iso_verif_traceur_pbid_ns(x,err_msg)
    2767         USE infotrac_phy, ONLY: ntraciso
    27682718        use isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
    27692719        use isotrac_mod, only: ridicule_trac
    … …  
    28282778
    28292779        subroutine iso_verif_traceur_pbid_vect(x,n,m,err_msg)
    2830         USE infotrac_phy, ONLY: ntraciso
    28312780        use isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
    28322781        use isotopes_verif_mod

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/limit_read_mod.F90

    r3927 r4368  
    281281    USE indice_sol_mod
    282282#ifdef ISO
    283     !USE infotrac_phy, ONLY: use_iso
    284283    USE isotopes_mod, ONLY : iso_HTO,ok_prod_nucl_tritium
    285284#ifdef ISOVERIF

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/ocean_forced_mod.F90

    r3975 r4368  
    4242    use config_ocean_skin_m, only: activate_ocean_skin
    4343#ifdef ISO
    44   USE infotrac_phy, ONLY: ntraciso,niso
     44  USE infotrac_phy, ONLY: ntiso,niso
    4545    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, &
    4646&       calcul_iso_surf_sic_vectall   
    … …  
    7373
    7474#ifdef ISO
    75     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
    76     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtspechum
     75    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
     76    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtspechum
    7777    real, dimension(klon), intent(IN) :: rlat
    7878#endif
    … …  
    9898
    9999#ifdef ISO     
    100     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)    :: xtevap ! isotopes in evaporation flux
     100    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux
    101101    REAL, DIMENSION(klon), INTENT(out)    :: h1 ! just a diagnostic, not useful for the simulation
    102102#endif
    … …  
    271271    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
    272272#ifdef ISO
    273   USE infotrac_phy, ONLY: niso,ntraciso
     273  USE infotrac_phy, ONLY: niso, ntiso
    274274    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, &
    275275&       calcul_iso_surf_sic_vectall
    … …  
    303303    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
    304304#ifdef ISO
    305     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
    306     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtspechum
    307     REAL, DIMENSION(niso,klon), INTENT(IN)    :: Roce
    308     REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
     305    REAL, DIMENSION(ntiso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
     306    REAL, DIMENSION(ntiso,klon), INTENT(IN)    :: xtspechum
     307    REAL, DIMENSION(niso,klon),  INTENT(IN)    :: Roce
     308    REAL, DIMENSION(niso,klon),  INTENT(IN)    :: Rland_ice
    309309#endif
    310310
    … …  
    330330    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
    331331#ifdef ISO     
    332     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)    :: xtevap
     332    REAL, DIMENSION(ntiso,klon), INTENT(OUT)    :: xtevap
    333333#endif     
    334334
    … …  
    467467#ifdef ISO
    468468! isotopes: tout est externalisé
    469 #ifdef ISOVERIF
    470         write(*,*) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall'
    471         write(*,*) 'klon,knon=',klon,knon
    472 #endif
     469!#ifdef ISOVERIF
     470!        write(*,*) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall'
     471!        write(*,*) 'klon,knon=',klon,knon
     472!#endif
    473473         call calcul_iso_surf_sic_vectall(klon,knon, &
    474474             &   evap,snow_evap_diag,Tsurf_new,Roce,snow, &
    … …  
    480480     &  )   
    481481#ifdef ISOVERIF
    482         write(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
     482        !write(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
    483483          if (iso_eau.gt.0) then
    484484           do i=1,knon 

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/pbl_surface_mod.F90

    r3962 r4368  
    1414  USE mod_grid_phy_lmdz,   ONLY : klon_glo
    1515  USE ioipsl
    16   USE surface_data,        ONLY : type_ocean, ok_veget
     16  USE surface_data,        ONLY : type_ocean, ok_veget, landice_opt
    1717  USE surf_land_mod,       ONLY : surf_land
    1818  USE surf_landice_mod,    ONLY : surf_landice
    … …  
    3131                                  wx_pbl_check, wx_pbl_dts_check, wx_evappot
    3232  use config_ocean_skin_m, only: activate_ocean_skin
     33#ifdef ISO
     34  USE infotrac_phy, ONLY: niso,ntraciso=>ntiso   
     35#endif
    3336
    3437  IMPLICIT NONE
    … …  
    193196    USE indice_sol_mod
    194197    USE print_control_mod, ONLY: lunout
    195   USE infotrac_phy, ONLY: niso,ntraciso ! ajout C Risi pour isos 
    196198#ifdef ISOVERIF
    197199    USE isotopes_mod, ONLY: iso_eau,ridicule
    … …  
    395397    USE print_control_mod,  ONLY : prt_level,lunout
    396398#ifdef ISO
    397   USE infotrac_phy, ONLY: ntraciso,niso ! ajout C Risi pour isos   
    398399  USE isotopes_mod, ONLY: Rdefault,iso_eau
    399400#ifdef ISOVERIF
    … …  
    23812382       CASE(is_lic)
    23822383          ! Martin
    2383           CALL surf_landice(itap, dtime, knon, ni, &
    2384                rlon, rlat, debut, lafin, &
    2385                yrmu0, ylwdown, yalb, zgeo1, &
    2386                ysolsw, ysollw, yts, ypplay(:,1), &
    2387 !!jyg               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    2388                ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
    2389                AcoefH, AcoefQ, BcoefH, BcoefQ, &
    2390                AcoefU, AcoefV, BcoefU, BcoefV, &
    2391                ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    2392                ysnow, yqsurf, yqsol, yagesno, &
    2393                ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
    2394                ytsurf_new, y_dflux_t, y_dflux_q, &
    2395                yzmea, yzsig, ycldt, &
    2396                ysnowhgt, yqsnow, ytoice, ysissnow, &
    2397                yalb3_new, yrunoff, &
    2398                y_flux_u1, y_flux_v1 &
    2399 #ifdef ISO
    2400            &    ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice &
    2401            &    ,yxtsnow,yxtsol,yxtevap &
     2384          IF (landice_opt .LT. 2) THEN
     2385             ! Land ice is treated by LMDZ and not by ORCHIDEE
     2386             
     2387             CALL surf_landice(itap, dtime, knon, ni, &
     2388                  rlon, rlat, debut, lafin, &
     2389                  yrmu0, ylwdown, yalb, zgeo1, &
     2390                  ysolsw, ysollw, yts, ypplay(:,1), &
     2391                  !!jyg               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     2392                  ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
     2393                  AcoefH, AcoefQ, BcoefH, BcoefQ, &
     2394                  AcoefU, AcoefV, BcoefU, BcoefV, &
     2395                  ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
     2396                  ysnow, yqsurf, yqsol, yagesno, &
     2397                  ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
     2398                  ytsurf_new, y_dflux_t, y_dflux_q, &
     2399                  yzmea, yzsig, ycldt, &
     2400                  ysnowhgt, yqsnow, ytoice, ysissnow, &
     2401                  yalb3_new, yrunoff, &
     2402                  y_flux_u1, y_flux_v1 &
     2403#ifdef ISO
     2404                  &    ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice &
     2405                  &    ,yxtsnow,yxtsol,yxtevap &
    24022406#endif             
    2403            &    )
    2404 
    2405 !jyg<
    2406 !!          alb3_lic(:)=0.
    2407 !>jyg
    2408           DO j = 1, knon
    2409              i = ni(j)
    2410              alb3_lic(i) = yalb3_new(j)
    2411              snowhgt(i)   = ysnowhgt(j)
    2412              qsnow(i)     = yqsnow(j)
    2413              to_ice(i)    = ytoice(j)
    2414              sissnow(i)   = ysissnow(j)
    2415              runoff(i)    = yrunoff(j)
    2416           ENDDO
    2417           ! Martin
    2418 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
    2419        IF (ok_prescr_ust) THEN
    2420           DO j=1,knon
    2421           y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
    2422           y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
    2423           ENDDO
    2424       ENDIF
    2425 
     2407                  &    )
     2408             
     2409             !jyg<
     2410             !!          alb3_lic(:)=0.
     2411             !>jyg
     2412             DO j = 1, knon
     2413                i = ni(j)
     2414                alb3_lic(i) = yalb3_new(j)
     2415                snowhgt(i)   = ysnowhgt(j)
     2416                qsnow(i)     = yqsnow(j)
     2417                to_ice(i)    = ytoice(j)
     2418                sissnow(i)   = ysissnow(j)
     2419                runoff(i)    = yrunoff(j)
     2420             ENDDO
     2421             ! Martin
     2422             ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
     2423             IF (ok_prescr_ust) THEN
     2424                DO j=1,knon
     2425                   y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
     2426                   y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
     2427                ENDDO
     2428             ENDIF
     2429             
    24262430#ifdef ISOVERIF
    2427         do j=1,knon
    2428           do ixt=1,ntraciso
    2429             call iso_verif_noNaN(yxtevap(ixt,j), &
    2430          &      'pbl_surface 1095a: apres surf_landice')
    2431             call iso_verif_noNaN(yxtsol(ixt,j), &
    2432          &      'pbl_surface 1095b: apres surf_landice')
    2433           enddo
    2434         enddo
     2431             do j=1,knon
     2432                do ixt=1,ntraciso
     2433                   call iso_verif_noNaN(yxtevap(ixt,j), &
     2434                        &      'pbl_surface 1095a: apres surf_landice')
     2435                   call iso_verif_noNaN(yxtsol(ixt,j), &
     2436                        &      'pbl_surface 1095b: apres surf_landice')
     2437                enddo
     2438             enddo
    24352439#endif
    24362440#ifdef ISOVERIF
    2437         write(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
    2438         do j=1,knon
    2439           if (iso_eau.gt.0) then     
    2440                  call iso_verif_egalite(yxtsnow(iso_eau,j), &
    2441      &                  ysnow(j),'pbl_surf_mod 1064')
    2442            endif !if (iso_eau.gt.0) then
    2443         enddo !do i=1,klon
    2444 #endif
    2445          
     2441             !write(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
     2442             do j=1,knon
     2443                if (iso_eau.gt.0) then     
     2444                   call iso_verif_egalite(yxtsnow(iso_eau,j), &
     2445                        &                  ysnow(j),'pbl_surf_mod 1064')
     2446                endif !if (iso_eau.gt.0) then
     2447             enddo !do i=1,klon
     2448#endif
     2449          END IF
    24462450       CASE(is_oce)
    24472451           CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
    … …  
    25302534#endif
    25312535#ifdef ISOVERIF
    2532         write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice'
     2536        !write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice'
    25332537        do j=1,knon
    25342538          if (iso_eau.gt.0) then     
    … …  
    32753279#ifdef ISO
    32763280#ifdef ISOVERIF
    3277        write(*,*) 'pbl_surface 2858'
     3281       !write(*,*) 'pbl_surface 2858'
    32783282       DO i = 1, klon
    32793283        do ixt=1,niso
    … …  
    40514055    USE indice_sol_mod
    40524056#ifdef ISO
    4053   USE infotrac_phy, ONLY: ntraciso,niso ! ajout C Risi pour isos 
    40544057#ifdef ISOVERIF
    40554058    USE isotopes_mod, ONLY: iso_eau,ridicule
    … …  
    41304133    use phys_state_var_mod, only: delta_sal, ds_ns, dt_ns, delta_sst
    41314134    use config_ocean_skin_m, only: activate_ocean_skin
    4132 #ifdef ISO
    4133   USE infotrac_phy, ONLY: ntraciso   
    4134 #endif
    41354135
    41364136

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/phyredem.F90

    r3940 r4368  
    2323                                wake_delta_pbl_tke, zmax0, f0, sig1, w01,    &
    2424                                wake_deltat, wake_deltaq, wake_s, wake_dens, &
     25                                awake_dens, cv_gen,                          &
    2526                                wake_cstar,                                  &
    2627                                wake_pe, wake_fip, fm_therm, entr_therm,     &
    … …  
    3839  USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var
    3940  USE traclmdz_mod, ONLY : traclmdz_to_restart
    40   USE infotrac_phy, ONLY: type_trac, niadv, tname, nbtr, nqo,itr_indice
     41  USE infotrac_phy, ONLY: types_trac, nqtot, tracers, nbtr, niso
    4142#ifdef ISO
    42   USE infotrac_phy, ONLY: itr_indice,niso,ntraciso
    4343#ifdef ISOVERIF
    4444  USE isotopes_verif_mod
    4545#endif
    4646#endif
    47   USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
     47  USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send, carbon_cycle_rad, RCO2_glo
    4848  USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic, epsfra
    4949  USE surface_data, ONLY: type_ocean, version_ocean
    … …  
    5656  include "dimsoil.h"
    5757  include "clesphys.h"
    58   include "thermcell.h"
     58  include "alpale.h"
    5959  include "compbl.h"
    6060  !======================================================================
    … …  
    7474  REAL Rland_ice(niso,klon)
    7575#endif
    76   INTEGER iq ! C Risi
    7776
    7877  INTEGER nid, nvarid, idim1, idim2, idim3
    … …  
    8584  CHARACTER (len=2) :: str2
    8685  CHARACTER (len=256) :: nam, lnam
    87   INTEGER           :: it, iiq, pass
     86  INTEGER           :: it, iq, pass
    8887
    8988  !======================================================================
    … …  
    131130
    132131  ! co2_ppm0 : initial value of atmospheric CO2
    133   tab_cntrl(16) = co2_ppm0
     132  ! tab_cntrl(16) = co2_ppm0
     133
     134  !  PC -- initial value of RCO2 for the radiation scheme
     135  !  tab_cntrl(17) = co2_ppm * 1.0e-06 * RMCO2 / RMD
     136  IF (carbon_cycle_rad) tab_cntrl(17) = RCO2_glo
     137  !PRINT*, "PC : phyredem RCO2_glo =",RCO2_glo
    134138
    135139  DO pass=1,2   ! pass=1 netcdf definition ; pass=2 netcdf write
    … …  
    185189    CALL put_field_srf1(pass,"TS","Temperature",ftsol(:,:))
    186190
    187 !!    CALL put_field_srf1(pass,"DELTA_TS","w-x surface temperature difference", delta_tsurf(:,:))
    188     CALL put_field_srf1(pass,"DELTATS","w-x surface temperature difference", delta_tsurf(:,:))
    189 
    190 !    CALL put_field_srf1(pass,"BETA_S","Aridity factor", beta_aridity(:,:))
    191     CALL put_field_srf1(pass,"BETAS","Aridity factor", beta_aridity(:,:))
     191    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
     192       CALL put_field_srf1(pass, "DELTATS", &
     193                      "w-x surface temperature difference",  delta_tsurf(:,:))
     194       CALL put_field_srf1(pass, "BETAS", "Aridity factor", beta_aridity(:,:))
     195    end IF
    192196!    End surface variables
    193197
    … …  
    313317    CALL put_field(pass,"WAKE_DENS", "Wake num. /unit area", wake_dens)
    314318
     319    CALL put_field(pass,"AWAKE_DENS", "Active Wake num. /unit area", awake_dens)
     320
     321    CALL put_field(pass,"CV_GEN", "CB birth rate", cv_gen)
     322
    315323    CALL put_field(pass,"WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
    316324
    … …  
    342350
    343351
    344     ! trs from traclmdz_mod
    345     IF (type_trac == 'lmdz') THEN
    346        CALL traclmdz_to_restart(trs)
    347        DO it=1, nbtr
    348 !!        iiq=niadv(it+2)                                                           ! jyg
    349           !iiq=niadv(it+nqo) ! C Risi: on efface pour remplacer:
    350           iq=itr_indice(it)                                                           ! jyg
    351           iiq=niadv(iq)                                                           ! jyg
    352           CALL put_field(pass,"trs_"//tname(iiq), "", trs(:, it))
    353        END DO
     352    IF (ANY(types_trac == 'co2i') .OR. ANY(types_trac == 'inco')) THEN
    354353       IF (carbon_cycle_cpl) THEN
    355354          IF (.NOT. ALLOCATED(co2_send)) THEN
    … …  
    360359          CALL put_field(pass,"co2_send", "co2_ppm for coupling", co2_send)
    361360       END IF
     361
     362    ! trs from traclmdz_mod
     363    ELSE IF (ANY(types_trac == 'lmdz')) THEN
     364       CALL traclmdz_to_restart(trs)
     365       it = 0
     366       DO iq = 1, nqtot
     367          IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     368          it = it+1
     369          CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it))
     370       END DO
    362371    END IF
    363372
    … …  
    408417  ENDDO ! DO pass=1,2   ! pass=1 netcdf definition ; pass=2 netcdf write
    409418 
    410 
    411  
    412419  !$OMP BARRIER
    413420
    … …  
    419426
    420427  IMPLICIT NONE
    421   INTEGER, INTENT(IN)            :: pass
     428  INTEGER, INTENT(IN)           :: pass
    422429  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
    423430  REAL,              INTENT(IN) :: field(:,:)
    … …  
    482489        xtrain_fall,xtsnow_fall, ql_ancien,xtl_ancien,qs_ancien,xts_ancien, &
    483490        xtsol,fxtevap
    484       USE infotrac_phy,ONLY: niso, ntraciso
     491      USE infotrac_phy,ONLY: niso, ntiso
    485492      !USE control_mod
    486493      USE indice_sol_mod, ONLY: nbsrf
    487494      USE iostart, ONLY: put_field
    488       USE isotopes_mod, ONLY: striso,iso_eau
     495      USE isotopes_mod, ONLY: isoName,iso_eau
    489496#ifdef ISOVERIF
    490497      USE isotopes_verif_mod
    … …  
    501508#include "dimsoil.h"
    502509#include "clesphys.h"
    503 #include "thermcell.h"
     510#include "alpale.h"
    504511#include "compbl.h"     
    505512      ! inputs
    506513      !REAL xtsol(niso,klon)
    507514      REAL xtsnow(niso,klon,nbsrf)
    508       !REAL xtevap(ntraciso,klon,nbsrf)     
     515      !REAL xtevap(ntiso,klon,nbsrf)     
    509516      REAL xtrun_off_lic_0(niso,klon)
    510517      REAL Rland_ice(niso,klon)
    … …  
    521528      CHARACTER*7 str7
    522529      CHARACTER*2 str2
    523       CHARACTER*50 striso_sortie
     530      CHARACTER*50 outiso
    524531      integer lnblnk
    525532#ifdef ISOTRAC
    … …  
    563570#endif
    564571
    565    do ixt=1,ntraciso
    566 
    567      if (ixt.le.niso) then
    568         striso_sortie=striso(ixt)
    569      else
    570 #ifdef ISOTRAC
    571         iiso=index_iso(ixt)
    572         izone=index_zone(ixt)       
    573         striso_sortie=striso(iiso)//strtrac(izone)
    574 #else
    575         write(*,*) 'phyredem 546: ixt,ntraciso=', ixt,ntraciso
    576         stop
    577 #endif
    578      endif !if (ixt.le.niso) then
    579       write(*,*) 'phyredem 550: ixt,striso_sortie=',ixt,striso_sortie(1:lnblnk(striso_sortie))
     572   do ixt=1,ntiso
     573
     574      outiso = TRIM(isoName(ixt))
     575      i = INDEX(outiso, '_', .TRUE.)
     576      outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
     577      write(*,*) 'phyredem 550: ixt,outiso=',ixt,TRIM(outiso)
    580578     
    581579      iso_tmp_lonsrf(:,:)=fxtevap(ixt,:,:)
    582       CALL put_field_srf1(pass,"XTEVAP"//striso_sortie(1:lnblnk(striso_sortie)), &
    583      &           "Evaporation de surface",iso_tmp_lonsrf)
     580      CALL put_field_srf1(pass, "XTEVAP"//TRIM(outiso), "Evaporation de surface",iso_tmp_lonsrf)
    584581
    585582      iso_tmp_lonsrf(:,:)=xtsnow(ixt,:,:)
    586       CALL put_field_srf1(pass,"XTSNOW"//striso_sortie(1:lnblnk(striso_sortie)), &
    587      &           "NEIGE",iso_tmp_lonsrf)       
     583      CALL put_field_srf1(pass, "XTSNOW"//TRIM(outiso), "NEIGE",       iso_tmp_lonsrf)       
    588584
    589585      iso_tmp(:)=xtrain_fall(ixt,:)
    590       CALL put_field(pass,"xtrain_f"//striso_sortie(1:lnblnk(striso_sortie)), &
    591      &   "precipitation liquide",iso_tmp)
     586      CALL put_field(pass,    "xtrain_f"//TRIM(outiso), "precipitation liquide",iso_tmp)
    592587
    593588      iso_tmp(:)=xtsnow_fall(ixt,:)
    594       CALL put_field(pass,"xtsnow_f"//striso_sortie(1:lnblnk(striso_sortie)), &
    595      &    "precipitation solide",iso_tmp)
     589      CALL put_field(pass,    "xtsnow_f"//TRIM(outiso), "precipitation solide",iso_tmp)
    596590
    597591      iso_tmp_lonlev(:,:)=xt_ancien(ixt,:,:)
    598       CALL put_field(pass,"XTANCIEN"//striso_sortie(1:lnblnk(striso_sortie)), &
    599      &   "QANCIEN",iso_tmp_lonlev)
     592      CALL put_field(pass,    "XTANCIEN"//TRIM(outiso), "QANCIEN",     iso_tmp_lonlev)
    600593
    601594      iso_tmp_lonlev(:,:)=xtl_ancien(ixt,:,:)
    602       CALL put_field(pass,"XTLANCIEN"//striso_sortie(1:lnblnk(striso_sortie)), &
    603      &   "QLANCIEN",iso_tmp_lonlev)
     595      CALL put_field(pass,   "XTLANCIEN"//TRIM(outiso), "QLANCIEN",    iso_tmp_lonlev)
    604596
    605597      iso_tmp_lonlev(:,:)=xts_ancien(ixt,:,:)
    606       CALL put_field(pass,"XTSANCIEN"//striso_sortie(1:lnblnk(striso_sortie)), &
    607      &   "QSANCIEN",iso_tmp_lonlev)
     598      CALL put_field(pass,   "XTSANCIEN"//TRIM(outiso), "QSANCIEN",    iso_tmp_lonlev)
    608599
    609600      iso_tmp_lonlev(:,:)=wake_deltaxt(ixt,:,:)
    610       CALL put_field(pass,"WAKE_DELTAXT"//striso_sortie(1:lnblnk(striso_sortie)), &
    611      &   "WAKE_DELTAQ",iso_tmp_lonlev)
     601      CALL put_field(pass,"WAKE_DELTAXT"//TRIM(outiso), "WAKE_DELTAQ", iso_tmp_lonlev)
    612602
    613603      iso_tmp(:)=xtrun_off_lic_0(ixt,:)
    614       CALL put_field(pass,"XTRUNOFFLIC0"//striso_sortie(1:lnblnk(striso_sortie)), &
    615      &   "Runofflic0",iso_tmp)
     604      CALL put_field(pass,"XTRUNOFFLIC0"//TRIM(outiso), "Runofflic0",  iso_tmp)
    616605
    617606      iso_tmp_lonlev(:,:)=wake_deltaxt(ixt,:,:)
    618       CALL put_field(pass,"WAKE_DELTAXT"//striso_sortie(1:lnblnk(striso_sortie)), &
    619      &   "WAKE_DELTAXT",iso_tmp_lonlev)
     607      CALL put_field(pass,"WAKE_DELTAXT"//TRIM(outiso), "WAKE_DELTAXT",iso_tmp_lonlev)
    620608
    621609      ! variables seulement pour niso:
    … …  
    623611
    624612      iso_tmp(:)=xtsol(ixt,:)
    625       CALL put_field(pass,"XTSOL"//striso_sortie(1:lnblnk(striso_sortie)), &
    626      &   "Eau dans le sol (mm)",iso_tmp)
     613      CALL put_field(pass,      "XTSOL"//TRIM(outiso), "Eau dans le sol (mm)",iso_tmp)
    627614
    628615      iso_tmp(:)=Rland_ice(ixt,:)
    629       CALL put_field(pass,"Rland_ice"//striso_sortie(1:lnblnk(striso_sortie)), &
    630      &   "ratio land ice",iso_tmp)
     616      CALL put_field(pass,  "Rland_ice"//TRIM(outiso), "ratio land ice",      iso_tmp)
    631617
    632618      endif ! if (ixt.le.niso) then

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/phys_local_var_mod.F90

    r4009 r4368  
    1616      REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:)
    1717      !$OMP THREADPRIVATE(u_seri, v_seri)
    18       REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:), l_mix(:,:,:), tke_dissip(:,:,:), wprime(:,:,:)
    19       !$OMP THREADPRIVATE(l_mixmin, l_mix, tke_dissip, wprime)
     18      REAL, SAVE, ALLOCATABLE :: rneb_seri(:,:)
     19      !$OMP THREADPRIVATE(rneb_seri)
     20      REAL, SAVE, ALLOCATABLE :: d_rneb_dyn(:,:)
     21      !$OMP THREADPRIVATE(d_rneb_dyn)
     22      REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:),l_mix(:,:,:),tke_dissip(:,:,:),wprime(:,:,:)
     23      !$OMP THREADPRIVATE(l_mixmin, l_mix, tke_dissip,wprime)
    2024      REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
    2125      !$OMP THREADPRIVATE(tr_seri)
    … …  
    465469      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: proba_notrig, random_notrig
    466470!$OMP THREADPRIVATE(proba_notrig, random_notrig)
    467       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cv_gen
    468 !$OMP THREADPRIVATE(cv_gen)
    469471      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: fsolsw, wfbils, wfbilo
    470472!$OMP THREADPRIVATE(fsolsw, wfbils, wfbilo)
    … …  
    557559      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: cldemi, cldfra, cldtau, fiwc, fl, re, flwc
    558560!$OMP THREADPRIVATE(cldemi, cldfra, cldtau, fiwc, fl, re, flwc)
    559       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: qlth, qith
    560 !$OMP THREADPRIVATE(qlth, qith)
     561      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: qlth, qith, qsith, wiceth
     562!$OMP THREADPRIVATE(qlth, qith, qsith, wiceth)
    561563      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: ref_liq, ref_ice, theta, zphi
    562564!$OMP THREADPRIVATE(ref_liq, ref_ice, theta, zphi)
    … …  
    603605      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zn2mout
    604606!$OMP THREADPRIVATE(zn2mout)
     607
     608      REAL, SAVE, ALLOCATABLE :: qclr(:,:)
     609      !$OMP THREADPRIVATE(qclr)
     610      REAL, SAVE, ALLOCATABLE :: qcld(:,:)
     611      !$OMP THREADPRIVATE(qcld)
     612      REAL, SAVE, ALLOCATABLE :: qss(:,:)
     613      !$OMP THREADPRIVATE(qss)
     614      REAL, SAVE, ALLOCATABLE :: qvc(:,:)
     615      !$OMP THREADPRIVATE(qvc)
     616      REAL, SAVE, ALLOCATABLE :: rnebclr(:,:)
     617      !$OMP THREADPRIVATE(rnebclr)
     618      REAL, SAVE, ALLOCATABLE :: rnebss(:,:)
     619      !$OMP THREADPRIVATE(rnebss)
     620      REAL, SAVE, ALLOCATABLE :: gamma_ss(:,:)
     621      !$OMP THREADPRIVATE(gamma_ss)
     622      REAL, SAVE, ALLOCATABLE :: N1_ss(:,:)
     623      !$OMP THREADPRIVATE(N1_ss)
     624      REAL, SAVE, ALLOCATABLE :: N2_ss(:,:)
     625      !$OMP THREADPRIVATE(N2_ss)
     626      REAL, SAVE, ALLOCATABLE :: drneb_sub(:,:)
     627      !$OMP THREADPRIVATE(drneb_sub)
     628      REAL, SAVE, ALLOCATABLE :: drneb_con(:,:)
     629      !$OMP THREADPRIVATE(drneb_con)
     630      REAL, SAVE, ALLOCATABLE :: drneb_tur(:,:)
     631      !$OMP THREADPRIVATE(drneb_tur)
     632      REAL, SAVE, ALLOCATABLE :: drneb_avi(:,:)
     633      !$OMP THREADPRIVATE(drneb_avi)
     634      REAL, SAVE, ALLOCATABLE :: zqsatl(:,:)
     635      !$OMP THREADPRIVATE(zqsatl)
     636      REAL, SAVE, ALLOCATABLE :: zqsats(:,:)
     637      !$OMP THREADPRIVATE(zqsats)
     638      REAL, SAVE, ALLOCATABLE :: Tcontr(:,:)
     639      !$OMP THREADPRIVATE(Tcontr)
     640      REAL, SAVE, ALLOCATABLE :: qcontr(:,:)
     641      !$OMP THREADPRIVATE(qcontr)
     642      REAL, SAVE, ALLOCATABLE :: qcontr2(:,:)
     643      !$OMP THREADPRIVATE(qcontr2)
     644      REAL, SAVE, ALLOCATABLE :: fcontrN(:,:)
     645      !$OMP THREADPRIVATE(fcontrN)
     646      REAL, SAVE, ALLOCATABLE :: fcontrP(:,:)
     647      !$OMP THREADPRIVATE(fcontrP)
    605648
    606649#ifdef CPP_StratAer
    … …  
    683726USE infotrac_phy, ONLY : nbtr
    684727#ifdef ISO
    685 USE infotrac_phy, ONLY : ntraciso,niso
     728USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
    686729#endif
    687730USE aero_mod
    … …  
    693736      ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
    694737      ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
    695       ALLOCATE(l_mixmin(klon,klev+1,nbsrf), l_mix(klon,klev+1,nbsrf), tke_dissip(klon,klev+1,nbsrf), wprime(klon,klev+1,nbsrf))
    696       l_mix(:,:,:)=0. ; l_mixmin(:,:,:)=0. ; tke_dissip(:,:,:)=0. ; wprime(:,:,:)=0. ! doit etre initialse car pas toujours remplis
     738      ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),tke_dissip(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf))
     739      l_mix(:,:,:)=0.;l_mixmin(:,:,:)=0.;tke_dissip(:,:,:)=0.;wprime(:,:,:)=0. ! doit etre initialse car pas toujours remplis
    697740
    698741      ALLOCATE(tr_seri(klon,klev,nbtr))
    … …  
    900943      ALLOCATE(rain_lsc(klon))
    901944      ALLOCATE(rain_num(klon))
    902       ALLOCATE(qlth(klon,klev), qith(klon,klev))
     945      ALLOCATE(qlth(klon,klev), qith(klon,klev), qsith(klon,klev), wiceth(klon,klev))
    903946      !
    904947#ifdef ISO
    … …  
    949992      alp_bl_stat(:)=0
    950993      ALLOCATE(proba_notrig(klon), random_notrig(klon))
    951       ALLOCATE(cv_gen(klon))
    952994
    953995      ALLOCATE(dnwd0(klon, klev))
    … …  
    9621004      ALLOCATE(ref_liq_pi(klon, klev), ref_ice_pi(klon, klev))
    9631005      ALLOCATE(zphi(klon, klev), zx_rh(klon, klev), zx_rhl(klon,klev), zx_rhi(klon,klev))
     1006      zx_rhl(:,:)=0.; zx_rhi(:,:)=0. ! because not always defined
    9641007      ALLOCATE(pmfd(klon, klev), pmfu(klon, klev))
    9651008
    … …  
    10401083
    10411084      ALLOCATE(zn2mout(klon,6))
     1085
     1086! Supersaturation
     1087      ALLOCATE(rneb_seri(klon,klev))
     1088      ALLOCATE(d_rneb_dyn(klon,klev))
     1089      ALLOCATE(qclr(klon,klev), qcld(klon,klev), qss(klon,klev), qvc(klon,klev))
     1090      ALLOCATE(rnebclr(klon,klev), rnebss(klon,klev), gamma_ss(klon,klev))
     1091      ALLOCATE(N1_ss(klon,klev), N2_ss(klon,klev))
     1092      ALLOCATE(drneb_sub(klon,klev), drneb_con(klon,klev), drneb_tur(klon,klev), drneb_avi(klon,klev))
     1093      ALLOCATE(zqsatl(klon,klev), zqsats(klon,klev))
     1094      ALLOCATE(Tcontr(klon,klev), qcontr(klon,klev), qcontr2(klon,klev), fcontrN(klon,klev), fcontrP(klon,klev))
    10421095
    10431096#ifdef CPP_StratAer
    … …  
    10901143      DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri)
    10911144      DEALLOCATE(u_seri,v_seri)
    1092       DEALLOCATE(l_mixmin,l_mix, tke_dissip, wprime)
     1145      DEALLOCATE(l_mixmin,l_mix, tke_dissip,wprime)
    10931146
    10941147      DEALLOCATE(tr_seri)
    … …  
    12721325      DEALLOCATE(rain_lsc)
    12731326      DEALLOCATE(rain_num)
    1274       DEALLOCATE(qlth, qith)
     1327      DEALLOCATE(qlth, qith, qsith, wiceth)
    12751328!
    12761329      DEALLOCATE(sens_x, sens_w)
    … …  
    13111364      DEALLOCATE(alp_bl_stat, n2, s2)
    13121365      DEALLOCATE(proba_notrig, random_notrig)
    1313       DEALLOCATE(cv_gen)
    13141366
    13151367      DEALLOCATE(dnwd0)
    … …  
    13931445      DEALLOCATE (t_tropopause)
    13941446      DEALLOCATE(zn2mout)
     1447
     1448! Supersaturation
     1449      DEALLOCATE(rneb_seri)
     1450      DEALLOCATE(d_rneb_dyn)
     1451      DEALLOCATE(qclr, qcld, qss, qvc)
     1452      DEALLOCATE(rnebclr, rnebss, gamma_ss)
     1453      DEALLOCATE(N1_ss, N2_ss)
     1454      DEALLOCATE(drneb_sub, drneb_con, drneb_tur, drneb_avi)
     1455      DEALLOCATE(zqsatl, zqsats)
     1456      DEALLOCATE(Tcontr, qcontr, qcontr2, fcontrN, fcontrP)
    13951457
    13961458#ifdef CPP_StratAer

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/phys_output_ctrlout_mod.F90

    r3940 r4368  
    19401940    'albslw3', 'Surface albedo LW3', '-', (/ ('', i=1, 10) /))
    19411941
     1942!--aviation & supersaturation
     1943  TYPE(ctrl_out), SAVE :: o_oclr = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1944    'oclr', 'Clear sky total water', 'kg/kg', (/ ('', i=1, 10) /))
     1945  TYPE(ctrl_out), SAVE :: o_ocld = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1946    'ocld', 'Cloudy sky total water', 'kg/kg', (/ ('', i=1, 10) /))
     1947  TYPE(ctrl_out), SAVE :: o_oss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1948    'oss', 'ISSR total water', 'kg/kg', (/ ('', i=1, 10) /))
     1949  TYPE(ctrl_out), SAVE :: o_ovc = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1950    'ovc', 'In-cloup vapor', 'kg/kg', (/ ('', i=1, 10) /))
     1951  TYPE(ctrl_out), SAVE :: o_rnebclr = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1952    'rnebclr', 'Clear sky fraction', '-', (/ ('', i=1, 10) /))
     1953  TYPE(ctrl_out), SAVE :: o_rnebss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1954    'rnebss', 'ISSR fraction', '-', (/ ('', i=1, 10) /))
     1955  TYPE(ctrl_out), SAVE :: o_rnebseri = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1956    'rnebseri', 'Cloud fraction', '-', (/ ('', i=1, 10) /))
     1957  TYPE(ctrl_out), SAVE :: o_gammass = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1958    'gammass', 'Gamma supersaturation', '', (/ ('', i=1, 10) /))
     1959  TYPE(ctrl_out), SAVE :: o_N1_ss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1960    'N1ss', 'N1', '', (/ ('', i=1, 10) /))
     1961  TYPE(ctrl_out), SAVE :: o_N2_ss = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1962    'N2ss', 'N2', '', (/ ('', i=1, 10) /))
     1963  TYPE(ctrl_out), SAVE :: o_drnebsub = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1964    'drnebsub', 'Cloud fraction change because of sublimation', 's-1', (/ ('', i=1, 10) /))
     1965  TYPE(ctrl_out), SAVE :: o_drnebcon = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1966    'drnebcon', 'Cloud fraction change because of condensation', 's-1', (/ ('', i=1, 10) /))
     1967  TYPE(ctrl_out), SAVE :: o_drnebtur = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1968    'drnebtur', 'Cloud fraction change because of turbulence', 's-1', (/ ('', i=1, 10) /))
     1969  TYPE(ctrl_out), SAVE :: o_drnebavi = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1970    'drnebavi', 'Cloud fraction change because of aviation', 's-1', (/ ('', i=1, 10) /))
     1971  TYPE(ctrl_out), SAVE :: o_qsatl = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1972    'qsatl', 'Saturation with respect to liquid water', '', (/ ('', i=1, 10) /))
     1973  TYPE(ctrl_out), SAVE :: o_qsats = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1974    'qsats', 'Saturation with respect to solid water', '', (/ ('', i=1, 10) /))
     1975  TYPE(ctrl_out), SAVE :: o_flight_m = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1976    'flightm', 'Flown meters', 'm/s/mesh', (/ ('', i=1, 10) /))
     1977  TYPE(ctrl_out), SAVE :: o_flight_h2o = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     1978    'flighth2o', 'H2O flight emission', 'kg H2O/s/mesh', (/ ('', i=1, 10) /))
     1979  TYPE(ctrl_out), SAVE :: o_Tcontr = ctrl_out((/ 1, 1, 1, 1, 11, 11, 11, 11, 11, 11/),&
     1980    'Tcontr', 'Temperature threshold for contrail formation', 'K', (/ ('',i=1,10) /))
     1981  TYPE(ctrl_out), SAVE :: o_qcontr = ctrl_out((/ 1, 1, 1, 1, 11, 11, 11, 11, 11, 11/),&
     1982    'qcontr', 'Specific humidity threshold for contrail formation','Pa', (/ ('', i=1, 10) /))
     1983  TYPE(ctrl_out), SAVE :: o_qcontr2 = ctrl_out((/ 1, 1, 1, 1, 11, 11, 11, 11, 11, 11/),&
     1984    'qcontr2', 'Specific humidity threshold for contrail formation','kg/kg', (/ ('', i=1, 10) /))
     1985  TYPE(ctrl_out), SAVE :: o_fcontrN = ctrl_out((/ 2, 2, 2, 2, 2, 2, 11, 11, 11, 11/),&
     1986    'fcontrN', 'Fraction with non-persistent contrail in clear-sky', '-', (/ ('', i=1,10)/))
     1987  TYPE(ctrl_out), SAVE :: o_fcontrP = ctrl_out((/ 2, 2, 2, 2, 2, 2, 11, 11, 11, 11/),&
     1988    'fcontrP', 'Fraction with persistent contrail in ISSR', '-', (/ ('', i=1,10)/))
     1989
    19421990!!!!!!!!!!!!! Sorties niveaux standards de pression NMC
    19431991  TYPE(ctrl_out), SAVE :: o_tnondef = ctrl_out((/ 11, 11, 11, 11, 11, 11, 5, 5, 5, 11/), &

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/phys_output_mod.F90

    r3940 r4368  
    3535    USE iophy
    3636    USE dimphy
    37     USE infotrac_phy, ONLY: nqtot, nqo, niadv, tname, ttext, type_trac, &
    38         nqtottr,itr_indice ! C Risi
     37    USE infotrac_phy, ONLY: nqtot, tracers, niso, ntraciso=>ntiso
     38    USE strings_mod,  ONLY: maxlen
    3939    USE ioipsl
    4040    USE phys_cal_mod, only : hour, calend
    … …  
    5252#endif
    5353#ifdef ISO
    54     USE infotrac_phy,ONLY: niso, ntraciso
    55     USE isotopes_mod, ONLY: striso,iso_HTO
     54    USE isotopes_mod, ONLY: isoName,iso_HTO
    5655#ifdef ISOTRAC
    5756    use isotrac_mod, only: index_zone,index_iso,strtrac
    … …  
    6160    IMPLICIT NONE
    6261    include "clesphys.h"
    63     include "thermcell.h"
     62    include "alpale.h"
    6463    include "YOMCST.h"
    6564
    … …  
    103102    CHARACTER(LEN=4), DIMENSION(nlevSTD)  :: clevSTD
    104103    REAL, DIMENSION(nlevSTD)              :: rlevSTD
    105     INTEGER                               :: nsrf, k, iq, iiq, iff, i, j, ilev
    106     INTEGER                               :: itr ! C Risi
     104    INTEGER                               :: nsrf, k, iq, iff, i, j, ilev, itr, ixt, iiso, izone
    107105    INTEGER                               :: naero
    108106    LOGICAL                               :: ok_veget
    … …  
    124122
    125123#ifdef ISO
    126       INTEGER  :: ixt,iiso,izone
    127       CHARACTER*50 :: striso_sortie
    128       integer :: lnblnk
    129 #endif
     124    CHARACTER(LEN=maxlen) :: outiso
     125    CHARACTER(LEN=20) :: unit
     126#endif
     127    CHARACTER(LEN=maxlen) :: tnam, lnam, dn
     128    INTEGER :: flag(nfiles)
    130129
    131130!!!!!!!!!! stockage dans une region limitee pour chaque fichier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    132131    !                 entre [phys_out_lonmin,phys_out_lonmax] et [phys_out_latmin,phys_out_latmax]
    133 
    134     LOGICAL, DIMENSION(nfiles), SAVE  :: phys_out_regfkey       = (/ .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
    135                                                                      .FALSE., .FALSE., .FALSE., .FALSE., .FALSE. /)
    136     REAL, DIMENSION(nfiles), SAVE     :: phys_out_lonmin        = (/ -180., -180., -180., -180., -180., &
    137                                                                      -180., -180., -180., -180., -180. /)
    138     REAL, DIMENSION(nfiles), SAVE     :: phys_out_lonmax        = (/  180.,  180.,  180.,  180.,  180., &
    139                                                                       180.,  180.,  180.,  180.,  180. /)
    140     REAL, DIMENSION(nfiles), SAVE     :: phys_out_latmin        = (/  -90.,  -90.,  -90.,  -90.,  -90., &
    141                                                                       -90.,  -90.,  -90.,  -90.,  -90. /)
    142     REAL, DIMENSION(nfiles), SAVE     :: phys_out_latmax        = (/   90.,   90.,   90.,   90.,   90., &
    143                                                                        90.,   90.,   90.,   90.,   90. /)
     132    LOGICAL, DIMENSION(nfiles), SAVE :: &
     133      phys_out_regfkey = [.FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE.]
     134    REAL,    DIMENSION(nfiles), SAVE :: &
     135      phys_out_lonmin  = [  -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.], &
     136      phys_out_lonmax  = [   180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.], &
     137      phys_out_latmin  = [   -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.], &
     138      phys_out_latmax  = [    90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.]
    144139    REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds
    145140    REAL, DIMENSION(klev+1)   :: lev_index
    … …  
    399394    CALL wxios_add_vaxis("bnds", 2, (/1.,2./))
    400395
    401      CALL wxios_add_vaxis("Alt", &
     396    CALL wxios_add_vaxis("Alt", &
    402397            levmax(iff) - levmin(iff) + 1, pseudoalt)
    403398
    404     IF (NSW.EQ.6) THEN
    405 !
    406 !wl1_sun: minimum bound of wavelength (in um)
    407 !
    408       wl1_sun(1)=0.180
    409       wl1_sun(2)=0.250
    410       wl1_sun(3)=0.440
    411       wl1_sun(4)=0.690
    412       wl1_sun(5)=1.190
    413       wl1_sun(6)=2.380
    414 !
    415 !wl2_sun: maximum bound of wavelength (in um)
    416 !
    417       wl2_sun(1)=0.250
    418       wl2_sun(2)=0.440
    419       wl2_sun(3)=0.690
    420       wl2_sun(4)=1.190
    421       wl2_sun(5)=2.380
    422       wl2_sun(6)=4.000
    423 !
    424     ELSE IF(NSW.EQ.2) THEN
    425 !
    426 !wl1_sun: minimum bound of wavelength (in um)
    427 !
    428       wl1_sun(1)=0.250
    429       wl1_sun(2)=0.690
    430 !
    431 !wl2_sun: maximum bound of wavelength (in um)
    432 !
    433       wl2_sun(1)=0.690
    434       wl2_sun(2)=4.000
    435     ENDIF
     399    ! wl1_sun/wl2_sun: minimum/maximum bound of wavelength (in um)
     400    SELECT CASE(NSW)
     401      CASE(6)
     402        wl1_sun(1:6) = [0.180, 0.250, 0.440, 0.690, 1.190, 2.380]
     403        wl2_sun(1:6) = [0.250, 0.440, 0.690, 1.190, 2.380, 4.000]
     404      CASE(2)
     405        wl1_sun(1:2) = [0.250, 0.690]
     406        wl2_sun(1:2) = [0.690, 4.000]
     407    END SELECT
    436408
    437409    DO ISW=1, NSW
    … …  
    531503     ENDIF ! clef_files
    532504
    533         write(lunout,*) 'phys_output_mid 496: nqtottr=',nqtottr
    534         write(lunout,*) 'itr_indice=',itr_indice
    535 !       IF (nqtot>=nqo+1) THEN
    536         IF (nqtottr>=1) THEN
    537 !
    538             !DO iq=nqo+1,nqtot
    539             ! C Risi: on modifie la boucle
    540             do itr=1,nqtottr ! C Risi
    541             iq=itr_indice(itr)  ! C Risi
    542             write(*,*) 'phys_output_mid 503: itr=',itr
    543  
    544             iiq=niadv(iq)
    545             o_trac(itr) = ctrl_out((/ 1, 5, 5, 5, 10, 10, 11, 11, 11, 11 /), &
    546                            tname(iiq),'Tracer '//ttext(iiq), "-",  &
    547                            (/ '', '', '', '', '', '', '', '', '', '' /))
    548             o_dtr_vdf(itr) = ctrl_out((/ 4, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    549                               'd'//trim(tname(iq))//'_vdf',  &
    550                               'Tendance tracer '//ttext(iiq), "-" , &
    551                               (/ '', '', '', '', '', '', '', '', '', '' /))
    552 
    553             o_dtr_the(itr) = ctrl_out((/ 5, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    554                               'd'//trim(tname(iq))//'_the', &
    555                               'Tendance tracer '//ttext(iiq), "-", &
    556                               (/ '', '', '', '', '', '', '', '', '', '' /))
    557 
    558             o_dtr_con(itr) = ctrl_out((/ 5, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    559                               'd'//trim(tname(iq))//'_con', &
    560                               'Tendance tracer '//ttext(iiq), "-", &
    561                               (/ '', '', '', '', '', '', '', '', '', '' /))
    562 
    563             o_dtr_lessi_impa(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    564                                      'd'//trim(tname(iq))//'_lessi_impa', &
    565                                      'Tendance tracer '//ttext(iiq), "-", &
    566                                      (/ '', '', '', '', '', '', '', '', '', '' /))
    567 
    568             o_dtr_lessi_nucl(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    569                                      'd'//trim(tname(iq))//'_lessi_nucl', &
    570                                      'Tendance tracer '//ttext(iiq), "-", &
    571                                      (/ '', '', '', '', '', '', '', '', '', '' /))
    572 
    573             o_dtr_insc(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    574                                'd'//trim(tname(iq))//'_insc', &
    575                                'Tendance tracer '//ttext(iiq), "-", &
    576                                (/ '', '', '', '', '', '', '', '', '', '' /))
    577 
    578             o_dtr_bcscav(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    579                                  'd'//trim(tname(iq))//'_bcscav', &
    580                                  'Tendance tracer '//ttext(iiq), "-", &
    581                                  (/ '', '', '', '', '', '', '', '', '', '' /))
    582 
    583             o_dtr_evapls(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    584                                  'd'//trim(tname(iq))//'_evapls', &
    585                                  'Tendance tracer '//ttext(iiq), "-", &
    586                                  (/ '', '', '', '', '', '', '', '', '', '' /))
    587 
    588             o_dtr_ls(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    589                              'd'//trim(tname(iq))//'_ls', &
    590                              'Tendance tracer '//ttext(iiq), "-", &
    591                              (/ '', '', '', '', '', '', '', '', '', '' /))
    592 
    593             o_dtr_trsp(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    594                                'd'//trim(tname(iq))//'_trsp', &
    595                                'Tendance tracer '//ttext(iiq), "-", &
    596                                (/ '', '', '', '', '', '', '', '', '', '' /))
    597 
    598             o_dtr_sscav(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    599                                 'd'//trim(tname(iq))//'_sscav', &
    600                                 'Tendance tracer '//ttext(iiq), "-", &
    601                                 (/ '', '', '', '', '', '', '', '', '', '' /))
    602 
    603             o_dtr_sat(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    604                                'd'//trim(tname(iq))//'_sat', &
    605                                'Tendance tracer '//ttext(iiq), "-", &
    606                                (/ '', '', '', '', '', '', '', '', '', '' /))
    607 
    608             o_dtr_uscav(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    609                                 'd'//trim(tname(iq))//'_uscav', &
    610                                 'Tendance tracer '//ttext(iiq), "-", &
    611                                  (/ '', '', '', '', '', '', '', '', '', '' /))
    612 
    613             o_dtr_dry(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11, 11 /), &
    614                               'cum'//'d'//trim(tname(iq))//'_dry', &
    615                               'tracer tendency dry deposition'//ttext(iiq), "-", &
    616                               (/ '', '', '', '', '', '', '', '', '', '' /))
    617 
    618             o_trac_cum(itr) = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11, 11 /), &
    619                                'cum'//tname(iiq),&
    620                                'Cumulated tracer '//ttext(iiq), "-", &
    621                                (/ '', '', '', '', '', '', '', '', '', '' /))
    622             ENDDO
    623       ENDIF
     505          itr = 0
     506          DO iq = 1, nqtot
     507            IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     508            itr = itr + 1
     509            dn = 'd'//TRIM(tracers(iq)%name)//'_'
     510
     511            flag = [1, 5, 5, 5, 10, 10, 11, 11, 11, 11]
     512            lnam = 'Tracer '//TRIM(tracers(iq)%longName)
     513            tnam = TRIM(tracers(iq)%name);  o_trac          (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     514
     515            flag = [4, 7, 7, 7, 10, 10, 11, 11, 11, 11]
     516            lnam = 'Tendance tracer '//TRIM(tracers(iq)%longName)
     517            tnam = TRIM(dn)//'vdf';         o_dtr_vdf       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     518
     519            flag = [5, 7, 7, 7, 10, 10, 11, 11, 11, 11]
     520            tnam = TRIM(dn)//'the';         o_dtr_the       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     521            tnam = TRIM(dn)//'con';         o_dtr_con       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     522
     523            flag = [7, 7, 7, 7, 10, 10, 11, 11, 11, 11]
     524            tnam = TRIM(dn)//'lessi_impa';  o_dtr_lessi_impa(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     525            tnam = TRIM(dn)//'lessi_nucl';  o_dtr_lessi_nucl(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     526            tnam = TRIM(dn)//'insc';        o_dtr_insc      (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     527            tnam = TRIM(dn)//'bcscav';      o_dtr_bcscav    (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     528            tnam = TRIM(dn)//'evapls';      o_dtr_evapls    (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     529            tnam = TRIM(dn)//'ls';          o_dtr_ls        (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     530            tnam = TRIM(dn)//'trsp';        o_dtr_trsp      (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     531            tnam = TRIM(dn)//'sscav';       o_dtr_sscav     (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     532            tnam = TRIM(dn)//'sat';         o_dtr_sat       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     533            tnam = TRIM(dn)//'uscav';       o_dtr_uscav     (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     534
     535            lnam = 'tracer tendency dry deposition'//TRIM(tracers(iq)%longName)
     536            tnam = 'cum'//TRIM(dn)//'dry';  o_dtr_dry       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     537
     538            flag = [1, 4, 10, 10, 10, 10, 11, 11, 11, 11]
     539            lnam = 'Cumulated tracer '//TRIM(tracers(iq)%longName)
     540            tnam = 'cum'//TRIM(tracers(iq)%name); o_trac_cum(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     541          ENDDO
    624542
    625543   ENDDO !  iff
    626544
    627         write(*,*) 'phys_output_mid 589'
    628545#ifdef ISO
    629   do ixt=1,ntraciso
    630      if (ixt.le.niso) then
    631         striso_sortie=striso(ixt)
    632      else
    633 #ifdef ISOTRAC
    634         iiso=index_iso(ixt)
    635         izone=index_zone(ixt)       
    636         striso_sortie=striso(iiso)//strtrac(izone)
    637 #else
    638         write(*,*) 'phys_output_mod 546: ixt,ntraciso=', ixt,ntraciso
    639         stop
    640 #endif
    641      endif
    642 
    643    o_xtprecip(ixt)=ctrl_out((/ 1, 1, 1, 10, 5, 10, 11, 11, 11, 11/), &
    644     'precip'//striso_sortie(1:lnblnk(striso_sortie)),  &
    645     'Precip Totale liq+sol', 'kg/(s*m2)', (/ ('', i=1, 10) /))   
    646    o_xtplul(ixt) = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11, 11/), &
    647     'plul'//striso_sortie(1:lnblnk(striso_sortie)),  &
    648     'Large-scale Precip.', 'kg/(s*m2)', (/ ('', i=1, 10) /))
    649    o_xtpluc(ixt) = ctrl_out((/ 1, 1, 1, 10, 5, 10, 11, 11, 11, 11/), &
    650     'pluc'//striso_sortie(1:lnblnk(striso_sortie)),  &
    651     'Convective Precip.', 'kg/(s*m2)', (/ ('', i=1, 10) /))
    652    o_xtevap(ixt) = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), &
    653     'evap'//striso_sortie(1:lnblnk(striso_sortie)),  &
    654     'Evaporat', 'kg/(s*m2)', (/ ('', i=1, 10) /))
    655    o_xtovap(ixt) = ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11, 11/), &
    656     'ovap'//striso_sortie(1:lnblnk(striso_sortie)),  &
    657     'Specific humidity', 'kg/kg', (/ ('', i=1, 10) /))
    658    o_xtoliq(ixt) = ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11, 11/), &
    659     'oliq'//striso_sortie(1:lnblnk(striso_sortie)),  &
    660     'Liquid water', 'kg/kg', (/ ('', i=1, 10) /))
    661    o_xtcond(ixt) = ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11, 11/), &
    662     'ocond'//striso_sortie(1:lnblnk(striso_sortie)),  &
    663     'Condensed water', 'kg/kg', (/ ('', i=1, 10) /))     
    664    o_dxtdyn(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    665     'dqdyn'//striso_sortie(1:lnblnk(striso_sortie)),  &
    666     'Dynamics dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
    667    o_dxtldyn(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    668     'dqldyn'//striso_sortie(1:lnblnk(striso_sortie)),  &
    669     'Dynamics dQL', '(kg/kg)/s', (/ ('', i=1, 10) /))
    670    o_dxtcon(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    671     'dqcon'//striso_sortie(1:lnblnk(striso_sortie)),  &
    672     'Convection dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
    673    o_dxteva(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    674     'dqeva'//striso_sortie(1:lnblnk(striso_sortie)),  &
    675     'Reevaporation dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
    676    o_dxtlsc(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    677     'dqlsc'//striso_sortie(1:lnblnk(striso_sortie)),  &
    678     'Condensation dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
    679    o_dxtajs(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    680     'dqajs'//striso_sortie(1:lnblnk(striso_sortie)),  &
    681     'Dry adjust. dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
    682    o_dxtvdf(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    683     'dqvdf'//striso_sortie(1:lnblnk(striso_sortie)),  &
    684     'Boundary-layer dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
    685    o_dxtthe(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    686     'dqthe'//striso_sortie(1:lnblnk(striso_sortie)),  &
    687     'Thermal dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
    688 
    689    IF (ok_qch4) then
    690      o_dxtch4(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    691         'dqch4'//striso_sortie(1:lnblnk(striso_sortie)),  &
    692     'H2O due to CH4 oxidation & photolysis', '(kg/kg)/s', (/ ('', i=1, 10) /))
    693    endif ! IF (ok_qch4) then
    694 
    695    if (ixt.eq.iso_HTO) then
    696       o_dxtprod_nucl(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    697         'dqprodnucl'//striso_sortie(1:lnblnk(striso_sortie)),  &
    698         'dHTO/dt due to nuclear production', '(kg/kg)/s', (/ ('', i=1, 10) /))
    699       o_dxtcosmo(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    700         'dqcosmo'//striso_sortie(1:lnblnk(striso_sortie)),  &
    701         'dHTO/dt due to cosmogenic production', '(kg/kg)/s', (/ ('', i=1, 10) /))
    702       o_dxtdecroiss(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    703         'dqdecroiss'//striso_sortie(1:lnblnk(striso_sortie)),  &
    704         'dHTO/dt due to radiative destruction', '(kg/kg)/s', (/ ('', i=1, 10) /))
    705    endif !if (ixt.eq.iso_HTO) then
    706   enddo !do ixt=1,niso
    707 #endif
    708         write(*,*) 'phys_output_mid 596'
     546    write(*,*) 'phys_output_mid 589'
     547    do ixt=1,ntraciso
     548      outiso = TRIM(isoName(ixt))
     549      i = INDEX(outiso, '_', .TRUE.)
     550      outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
     551
     552      flag = [1,  1,  1, 10,  5, 10, 11, 11, 11, 11]; unit = 'kg/(s*m2)'
     553      o_xtprecip(ixt)=ctrl_out(flag, 'precip'//TRIM(outiso), 'Precip Totale liq+sol', unit, [('',i=1,nfiles)])
     554      o_xtpluc  (ixt)=ctrl_out(flag,   'pluc'//TRIM(outiso),    'Convective Precip.', unit, [('',i=1,nfiles)])
     555
     556      flag = [1,  1,  1, 10, 10, 10, 11, 11, 11, 11]
     557      o_xtplul  (ixt)=ctrl_out(flag,   'plul'//TRIM(outiso),   'Large-scale Precip.', unit, [('',i=1,nfiles)])
     558      o_xtevap  (ixt)=ctrl_out(flag,   'evap'//TRIM(outiso),             'Evaporat.', unit, [('',i=1,nfiles)])
     559
     560      flag = [2,  3,  4, 10, 10, 10, 11, 11, 11, 11]; unit = 'kg/kg'
     561      o_xtovap  (ixt)=ctrl_out(flag,   'ovap'//TRIM(outiso),     'Specific humidity', unit, [('',i=1,nfiles)])
     562      o_xtoliq  (ixt)=ctrl_out(flag,   'oliq'//TRIM(outiso),          'Liquid water', unit, [('',i=1,nfiles)])
     563      o_xtcond  (ixt)=ctrl_out(flag,  'ocond'//TRIM(outiso),       'Condensed water', unit, [('',i=1,nfiles)])
     564
     565      flag = [4, 10, 10, 10, 10, 10, 11, 11, 11, 11]; unit = '(kg/kg)/s'
     566      o_dxtdyn  (ixt)=ctrl_out(flag,  'dqdyn'//TRIM(outiso),           'Dynamics dQ', unit, [('',i=1,nfiles)])
     567      o_dxtldyn (ixt)=ctrl_out(flag, 'dqldyn'//TRIM(outiso),          'Dynamics dQL', unit, [('',i=1,nfiles)])
     568      o_dxtcon  (ixt)=ctrl_out(flag,  'dqcon'//TRIM(outiso),         'Convection dQ', unit, [('',i=1,nfiles)])
     569      o_dxteva  (ixt)=ctrl_out(flag,  'dqeva'//TRIM(outiso),      'Reevaporation dQ', unit, [('',i=1,nfiles)])
     570      o_dxtlsc  (ixt)=ctrl_out(flag,  'dqlsc'//TRIM(outiso),       'Condensation dQ', unit, [('',i=1,nfiles)])
     571      o_dxtajs  (ixt)=ctrl_out(flag,  'dqajs'//TRIM(outiso),        'Dry adjust. dQ', unit, [('',i=1,nfiles)])
     572      o_dxtvdf  (ixt)=ctrl_out(flag,  'dqvdf'//TRIM(outiso),     'Boundary-layer dQ', unit, [('',i=1,nfiles)])
     573      o_dxtthe  (ixt)=ctrl_out(flag,  'dqthe'//TRIM(outiso),            'Thermal dQ', unit, [('',i=1,nfiles)])
     574
     575      IF(ok_qch4) o_dxtch4(ixt)=ctrl_out(flag, 'dqch4'//TRIM(outiso), 'H2O due to CH4 oxidation & photolysis', &
     576                                                                                      unit, [('',i=1,nfiles)])
     577      IF(ixt == iso_HTO) THEN
     578      o_dxtprod_nucl(ixt)=ctrl_out(flag, 'dqprodnucl'//TRIM(outiso), 'dHTO/dt due to nuclear production',      &
     579                                                                                      unit, [('',i=1,nfiles)])
     580      o_dxtcosmo    (ixt)=ctrl_out(flag,    'dqcosmo'//TRIM(outiso), 'dHTO/dt due to cosmogenic production',   &
     581                                                                                      unit, [('',i=1,nfiles)])
     582      o_dxtdecroiss (ixt)=ctrl_out(flag, 'dqdecroiss'//TRIM(outiso), 'dHTO/dt due to radiative destruction',   &
     583                                                                                      unit, [('',i=1,nfiles)])
     584      END IF
     585    enddo !do ixt=1,niso
     586    write(*,*) 'phys_output_mid 596'
     587#endif
    709588
    710589

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/physiq_mod.F90

    r4009 r4368  
    3939    USE ioipsl_getin_p_mod, ONLY : getin_p
    4040    USE indice_sol_mod
    41     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac,ok_isotopes, &
    42         nqtottr,itr_indice ! C Risi
    43 
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac, nqCO2
     42    USE readTracFiles_mod, ONLY: addPhase
     43    USE strings_mod,  ONLY: strIdx, strStack, int2str
    4444    USE iophy
    4545    USE limit_read_mod, ONLY : init_limit_read
    … …  
    5353    USE pbl_surface_mod, ONLY : pbl_surface
    5454    USE phyaqua_mod, only: zenang_an
     55    USE phyetat0_mod, only: phyetat0
    5556    USE phystokenc_mod, ONLY: offline, phystokenc
    5657    USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
    … …  
    6162    USE phys_output_mod
    6263    USE phys_output_ctrlout_mod
    63     USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
     64    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level, &
     65         alert_first_call, call_alert, prt_alerte
    6466    USE readaerosol_mod, ONLY : init_aero_fromfile
    6567    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
    … …  
    7274    USE tracinca_mod, ONLY: config_inca
    7375    USE tropopause_m,     ONLY: dyn_tropopause
     76    USE ice_sursat_mod,  ONLY: flight_init, airplane
    7477    USE vampir
    7578    USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
    7679    USE write_field_phy
    7780    USE lscp_mod, ONLY : lscp
     81    USE thermcell_ini_mod, ONLY : thermcell_ini
    7882
    7983    !USE cmp_seri_mod
    … …  
    122126
    123127#ifdef ISO
    124     USE infotrac_phy, ONLY:  &
    125         iqiso,iso_num,iso_indnum,zone_num,ok_isotrac, &
    126         niso,ntraciso,nqtottr,itr_indice ! ajout C Risi pour isos
    127      USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO, &
     128    USE infotrac_phy, ONLY: iqIsoPha,niso, ntraciso=>ntiso, nzone
     129    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO, &
    128130        & bidouille_anti_divergence,ok_bidouille_wake, &
    129131        & modif_ratqs,essai_convergence,iso_init,ridicule_rain,tnat, &
    130132        & ridicule,ridicule_snow
    131      USE isotopes_routines_mod, ONLY: iso_tritium
     133    USE isotopes_routines_mod, ONLY: iso_tritium
    132134#ifdef ISOVERIF
    133135    USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
    … …  
    141143        & iso_verif_aberrant_choix,iso_verif_positif, &
    142144        & iso_verif_positif_choix_vect,iso_verif_o18_aberrant_nostop, &
    143         & iso_verif_init, &
     145        & iso_verif_init,&
    144146        & iso_verif_positif_strict_nostop,iso_verif_O18_aberrant_enc_vect2D
    145147#endif
    … …  
    155157&       iso_verif_traceur_justmass,iso_verif_traceur_vect, &
    156158&       iso_verif_trac17_q_deltad,iso_verif_trac_masse_vect, &
    157 &       iso_verif_tracpos_choix_nostop
     159&       iso_verif_tag17_q_deltaD_vect, iso_verif_tracpos_choix_nostop
    158160#endif
    159161#endif
    … …  
    167169       ! [Variables internes non sauvegardees de la physique]
    168170       ! Variables locales pour effectuer les appels en serie
    169        t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,tr_seri, &
     171       t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,tr_seri,rneb_seri, &
    170172       ! Dynamic tendencies (diagnostics)
    171        d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn, &
     173       d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, &
    172174       d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, &
    173175       ! Physic tendencies
    … …  
    188190       !
    189191       d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_t_diss, &
    190        d_t_vdf_w,d_q_vdf_w, &
    191        d_t_vdf_x,d_q_vdf_x, &
     192       d_t_vdf_x, d_t_vdf_w, &
     193       d_q_vdf_x, d_q_vdf_w, &
    192194       d_ts, &
    193195       !
    … …  
    262264       zxfluxlat_x, zxfluxlat_w, &
    263265       !
    264        d_t_vdf_x, d_t_vdf_w, &
    265        d_q_vdf_x, d_q_vdf_w, &
    266        pbl_tke_input, tke_dissip, l_mix, wprime, &
     266       pbl_tke_input, tke_dissip, l_mix, wprime,&
    267267       t_therm, q_therm, u_therm, v_therm, &
    268268       cdragh_x, cdragh_w, &
    … …  
    291291       alp_bl_stat, n2, s2,  &
    292292       proba_notrig, random_notrig,  &
    293        cv_gen,  &
     293!!       cv_gen,  &  !moved to phys_state_var_mod
    294294       !
    295295       dnwd0,  &
    … …  
    422422    include "dimsoil.h"
    423423    include "clesphys.h"
    424     include "thermcell.h"
     424    include "alpale.h"
    425425    include "dimpft.h"
    426426    !======================================================================
    … …  
    509509    !======================================================================
    510510    !
    511     INTEGER ivap          ! indice de traceurs pour vapeur d'eau
    512     PARAMETER (ivap=1)
    513     INTEGER iliq          ! indice de traceurs pour eau liquide
    514     PARAMETER (iliq=2)
    515     !CR: on ajoute la phase glace
    516     INTEGER isol          ! indice de traceurs pour eau glace
    517     PARAMETER (isol=3)
     511    ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional)
     512    INTEGER,SAVE :: ivap, iliq, isol, irneb
     513!$OMP THREADPRIVATE(ivap, iliq, isol, irneb)
    518514    !
    519515    !
    … …  
    874870    !C      EXTERNAL o3cm      ! initialiser l'ozone
    875871    EXTERNAL orbite    ! calculer l'orbite terrestre
    876     EXTERNAL phyetat0  ! lire l'etat initial de la physique
    877872    EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
    878873    EXTERNAL suphel    ! initialiser certaines constantes
    … …  
    939934    real zqsat(klon,klev)
    940935    !
    941     INTEGER i, k, iq, j, nsrf, ll, l
    942     INTEGER itr ! C Risi
     936    INTEGER i, k, iq, j, nsrf, ll, l, itr
    943937#ifdef ISO
    944938    real zxt_apres(ntraciso,klon)
    … …  
    11331127!JLD    REAL zstophy, zout
    11341128
    1135     CHARACTER*20 modname
     1129    CHARACTER (LEN=20) :: modname='physiq_mod'
    11361130    CHARACTER*80 abort_message
    11371131    LOGICAL, SAVE ::  ok_sync, ok_sync_omp
    … …  
    13061300    pi = 4. * ATAN(1.)
    13071301
     1302    ! set-up call to alerte function
     1303    call_alert = (alert_first_call .AND. is_master)
     1304   
    13081305    ! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
    13091306    jjmp1=nbp_lat
    … …  
    13501347
    13511348    IF (first) THEN
     1349       ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
     1350       iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
     1351       isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
     1352       irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
    13521353       CALL init_etat0_limit_unstruct
    13531354       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
    … …  
    13881389       IF ((iflag_ice_thermo.gt.0).and.(nqo==2)) THEN
    13891390          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
    1390                '(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.'
     1391               '(H2O_g, H2O_l, H2O_s) but nqo=', nqo, '. Might as well stop here.'
     1392          abort_message='see above'
     1393          CALL abort_physic(modname,abort_message,1)
     1394       ENDIF
     1395
     1396       IF (ok_ice_sursat.AND.(iflag_ice_thermo.EQ.0)) THEN
     1397          WRITE (lunout, *) ' ok_ice_sursat=y requires iflag_ice_thermo=1 as well'
     1398          abort_message='see above'
     1399          CALL abort_physic(modname,abort_message,1)
     1400       ENDIF
     1401
     1402       IF (ok_ice_sursat.AND.(nqo.NE.4)) THEN
     1403          WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', &
     1404               '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.'
    13911405          abort_message='see above'
    13921406          CALL abort_physic(modname,abort_message,1)
    … …  
    14241438    forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
    14251439
    1426     modname = 'physiq'
    14271440
    14281441    IF (debut) THEN
    … …  
    15261539       tau_overturning_th(:)=0.
    15271540
    1528        IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
     1541       IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN
    15291542          ! jg : initialisation jusqu'au ces variables sont dans restart
    15301543          ccm(:,:,:) = 0.
    … …  
    15781591! dyn3dmem et physiq
    15791592#ifdef ISO
    1580     write(*,*) 'physiq 1846a: ok_isotopes,ntraciso,niso=',ok_isotopes,ntraciso,niso
    1581     if (.not.ok_isotopes) then
    1582       CALL abort_gcm('physiq 1756','options iso incompatibles',1)
    1583     endif
     1593    write(*,*) 'physiq 1846a: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
     1594    IF(niso  <= 0) CALL abort_gcm('physiq 1756','options iso incompatibles',1)
    15841595#ifdef ISOTRAC
    1585     if (.not.ok_isotrac) then
    1586       CALL abort_gcm('physiq 1758','options isotrac incompatibles',1)
    1587     endif   
     1596    IF(nzone <= 0) CALL abort_gcm('physiq 1758','options isotrac incompatibles',1)
    15881597#else
    1589 ! #ifdef ISOTRAC
    1590     if (ok_isotrac) then
    1591       CALL abort_gcm('physiq 1762','options isotrac incompatibles',1)
    1592     endif
    1593 #endif
    1594 !! #ifdef ISOTRAC
    1595 ! -> on supprime opion ISOTRAC, tout passe par ok_isotrac
     1598    IF(nzone  > 0) CALL abort_gcm('physiq 1762','options isotrac incompatibles',1)
     1599#endif
    15961600#else
    1597 ! #ifdef ISO
    1598     if (ok_isotopes) then
    1599       CALL abort_gcm('physiq 1772','options iso incompatibles',1)
    1600     endif
    1601 #endif
    1602 ! #ifdef ISO
     1601    if(niso   > 0) CALL abort_gcm('physiq 1772','options iso incompatibles',1)
     1602#endif
    16031603
    16041604#ifdef ISO
    … …  
    16061606#ifdef ISOVERIF
    16071607           write(*,*) 'physiq 1366: call iso_init'
    1608            write(*,*) 'ok_isotopes=',ok_isotopes
    1609 #endif
    1610         if (ok_isotopes) then
    1611            call iso_init()
    1612         endif
     1608           write(*,*) 'ok_isotopes=',niso > 0
     1609#endif
     1610        if (niso > 0) call iso_init()
    16131611#ifdef ISOTRAC
    1614 if (ok_isotrac) then
     1612IF(nzone > 0) then
    16151613        write(*,*) 'physiq 1416: call iso_traceurs_init'
    16161614        call iso_traceurs_init()
    … …  
    18541852       CALL iniradia(klon,klev,paprs(1,1:klev+1))
    18551853
    1856        ! Initialisation des champs dans phytrac* qui sont utilisés par phys_output_write*
     1854
     1855!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1856       CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, &
     1857   &    RG,RD,RCPD,RKAPPA,RLVTT,RETV)
     1858       !
     1859!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1860       ! Initialisation des champs dans phytrac* qui sont utilises par phys_output_write*
     1861       !
     1862!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1863
    18571864#ifdef CPP_Dust
    18581865       ! Quand on utilise SPLA, on force iflag_phytrac=1
    … …  
    18991906            ENDDO
    19001907          ENDDO
    1901         ELSE
     1908       ELSE
    19021909          pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
    19031910!>jyg
    … …  
    19491956          CALL abort_physic(modname,abort_message,1)
    19501957       ENDIF
     1958
     1959!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1960       ! Initialisation pour la convection de K.E. et pour les poches froides
     1961       !
     1962!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1963
    19511964       WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
    1952        WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", &
    1953             ok_cvl
     1965       WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", ok_cvl
    19541966       !
    19551967       !KE43
    … …  
    20042016             d_deltaxt_ajs_cv(:,:,:) = 0.
    20052017#endif
    2006           ENDIF
     2018          ENDIF  !  (iflag_wake>=1)
    20072019
    20082020          !        do i = 1,klon
    … …  
    20152027       !   ALLOCATE(lonGCM(0), latGCM(0))
    20162028       !   ALLOCATE(iGCM(0), jGCM(0))
    2017        ENDIF
    2018 
     2029       ENDIF  !  (iflag_con.GE.3)
     2030       !
    20192031       DO i=1,klon
    20202032          rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
    … …  
    20852097       !$OMP BARRIER
    20862098       missing_val=missing_val_omp
     2099       !
     2100       ! Now we activate some double radiation call flags only if some
     2101       ! diagnostics are requested, otherwise there is no point in doing this
     2102       IF (is_master) THEN
     2103         !--setting up swaero_diag to TRUE in XIOS case
     2104         IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. &
     2105            xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. &
     2106            xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  &
     2107              (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. &
     2108                                  xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  &
     2109            !!!--for now these fields are not in the XML files so they are omitted
     2110            !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) &
     2111            swaero_diag=.TRUE.
     2112 
     2113         !--setting up swaerofree_diag to TRUE in XIOS case
     2114         IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
     2115            xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
     2116            xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
     2117            xios_field_is_active("LWupTOAcleanclr")) &
     2118            swaerofree_diag=.TRUE.
     2119 
     2120         !--setting up dryaod_diag to TRUE in XIOS case
     2121         DO naero = 1, naero_tot-1
     2122          IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE.
     2123         ENDDO
     2124         !
     2125         !--setting up ok_4xCO2atm to TRUE in XIOS case
     2126         IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. &
     2127            xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
     2128            xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
     2129            xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
     2130            xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
     2131            xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
     2132            ok_4xCO2atm=.TRUE.
     2133       ENDIF
     2134       !$OMP BARRIER
     2135       CALL bcast(swaero_diag)
     2136       CALL bcast(swaerofree_diag)
     2137       CALL bcast(dryaod_diag)
     2138       CALL bcast(ok_4xCO2atm)
    20872139#endif
    2088 
    2089 
     2140       !
    20902141       CALL printflag( tabcntr0,radpas,ok_journe, &
    20912142            ok_instan, ok_region )
    20922143       !
    20932144       !
    2094        !
    20952145       ! Prescrire l'ozone dans l'atmosphere
    2096        !
    20972146       !
    20982147       !c         DO i = 1, klon
    … …  
    21022151       !c         ENDDO
    21032152       !
    2104        IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN                   ! ModThL
     2153       IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN  ! ModThL
    21052154#ifdef INCA
    21062155          CALL VTe(VTphysiq)
    … …  
    21502199#endif
    21512200       ENDIF
    2152        IF (type_trac == 'repr') THEN
     2201       !
     2202       IF (ANY(types_trac == 'repr')) THEN
    21532203#ifdef REPROBUS
    21542204          CALL chemini_rep(  &
    … …  
    21982248          SFRWL(6)=3.02191470E-02
    21992249       END SELECT
    2200 
    2201 
    22022250       !albedo SB <<<
    22032251
    … …  
    22682316
    22692317    ! Update time and other variables in Reprobus
    2270     IF (type_trac == 'repr') THEN
     2318    IF (ANY(types_trac == 'repr')) THEN
    22712319#ifdef REPROBUS
    22722320       CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
    … …  
    23312379      ! RomP <<<
    23322380    ENDIF
    2333 
    23342381    !
    23352382    ! Ne pas affecter les valeurs entrees de u, v, h, et q
    … …  
    23472394          ELSE IF (nqo.eq.3) THEN
    23482395             qs_seri(i,k) = qx(i,k,isol)
     2396          ELSE IF (nqo.eq.4) THEN
     2397             qs_seri(i,k) = qx(i,k,isol)
     2398             rneb_seri(i,k) = qx(i,k,irneb)
    23492399          ENDIF
    23502400       ENDDO
    … …  
    23542404#ifdef ISO
    23552405#ifdef ISOVERIF
    2356     write(*,*) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
    2357     write(*,*) 'physiq 1846b: ok_isotopes,ntraciso,niso=',ok_isotopes,ntraciso,niso
     2406!    write(*,*) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
     2407    write(*,*) 'physiq 1846b: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
    23582408#endif
    23592409    do ixt=1,ntraciso
    23602410#ifdef ISOVERIF
    2361       write(*,*) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqiso(ixt,ivap)
    2362       write(*,*) 'physiq tmp 1762b: ixt,iqiso_liq=',ixt,iqiso(ixt,iliq)
     2411      write(*,*) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqIsoPha(ixt,ivap)
     2412      write(*,*) 'physiq tmp 1762b: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
    23632413      if (nqo.eq.3) then 
    2364         write(*,*) 'physiq tmp 1762c: ixt,iqiso_liq=',ixt,iqiso(ixt,iliq)
     2414        write(*,*) 'physiq tmp 1762c: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
    23652415      endif !if (nqo.eq.3) then
    23662416#endif
    2367       if (ixt.gt.niso) then
    2368       write(*,*) 'izone,iiso=',zone_num(iqiso(ixt,ivap)),iso_indnum(iqiso(ixt,ivap)) 
    2369       endif
     2417      if (ixt.gt.niso) write(*,*) 'izone=',tracers(iqIsoPha(ixt,ivap))%iso_iZone
    23702418      DO k = 1, klev
    23712419       DO i = 1, klon
    2372           xt_seri(ixt,i,k)  = qx(i,k,iqiso(ixt,ivap))
    2373           xtl_seri(ixt,i,k) = qx(i,k,iqiso(ixt,iliq))
     2420          xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
     2421          xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
    23742422          if (nqo.eq.2) then
    23752423             xts_seri(ixt,i,k) = 0.
    23762424          else if (nqo.eq.3) then
    2377              xts_seri(ixt,i,k) = qx(i,k,iqiso(ixt,isol))
     2425             xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
    23782426          endif
    23792427       enddo !DO i = 1, klon
    … …  
    23842432#endif
    23852433! #ifdef ISO
    2386 
    23872434    !
    23882435    !--OB mass fixer
    … …  
    24082455
    24092456    tke0(:,:)=pbl_tke(:,:,is_ave)
    2410     !C Risi:Nombre de traceurs de l'eau: nqo
    2411     !  IF (nqtot.GE.3) THEN
    2412     IF (nqtot.GE.(nqo+1)) THEN
    2413        !     DO iq = 3, nqtot       
    2414 !       DO iq = nqo+1, nqtot 
    2415        ! CR: on modifie directement le code ici.
    2416        ! les isotopes ne sont pas dispatchés dans tr_seri, il faut les enlever.
    2417        ! on a prévu pour ça un tableau d'indice dans infotrac
    2418 #ifdef ISOVERIF
    2419        write(*,*) 'physiq 1971: nqtottr=',nqtottr
    2420 #endif
    2421        do itr=1,nqtottr
    2422          iq=itr_indice(itr)
    2423 #ifdef ISOVERIF
    2424          write(*,*) 'physiq 1973: itr,iq=',itr,iq
    2425          write(*,*) 'qx(1,1,iq)=',qx(1,1,iq)
    2426 #endif
     2457    IF (nqtot > nqo) THEN
     2458       ! water isotopes are not included in tr_seri
     2459       itr = 0
     2460       DO iq = 1, nqtot
     2461         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
     2462         itr = itr+1
     2463!#ifdef ISOVERIF
     2464!         write(*,*) 'physiq 1973: itr,iq=',itr,iq
     2465!         write(*,*) 'qx(1,1,iq)=',qx(1,1,iq)
     2466!#endif
    24272467         DO  k = 1, klev
    24282468             DO  i = 1, klon
    2429                 tr_seri(i,k,itr) = qx(i,k,iq) ! modif C Risi
     2469                tr_seri(i,k,itr) = qx(i,k,iq)
    24302470             ENDDO
    2431           ENDDO !DO  k = 1, klev
    2432           !write(*,*) 'physiq 1980'
    2433        enddo !do itr=1,nqtottr
    2434 
    2435     ELSE !IF (nqtot.GE.(nqo+1)) THEN
    2436        DO k = 1, klev
    2437           DO i = 1, klon
    2438              tr_seri(i,k,1) = 0.0
    24392471          ENDDO
    24402472       ENDDO
    2441     ENDIF !IF (nqtot.GE.(nqo+1)) THEN
     2473    ELSE
     2474! DC: make sure the final "1" index was meant for 1st H2O phase (vapor) !!!
     2475       tr_seri(:,:,strIdx(tracers(:)%name,addPhase('H2O','g'))) = 0.0
     2476    ENDIF
    24422477!
    24432478! Temporary solutions adressing ticket #104 and the non initialisation of tr_ancien
    … …  
    24452480    IF (debut) THEN
    24462481      WRITE(lunout,*)' WARNING: tr_ancien initialised to tr_seri'
    2447 !      DO iq = nqo+1, nqtot
    2448 !           tr_ancien(:,:,iq-nqo)=tr_seri(:,:,iq-nqo)
    2449 !      ENDDO
    2450        ! modif CRisi:
    2451        do itr=1,nqtottr
     2482       itr = 0
     2483       do iq = 1, nqtot
     2484         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
     2485         itr = itr+1
    24522486         tr_ancien(:,:,itr)=tr_seri(:,:,itr)       
    24532487       enddo
    … …  
    24672501    ! Diagnostiquer la tendance dynamique
    24682502#ifdef ISOVERIF
    2469       write(*,*) 'physiq tmp 2010: ancien_ok=',ancien_ok       
    24702503      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then 
    24712504        do i=1,klon
    … …  
    25192552       d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep
    25202553       ! !! RomP >>>   td dyn traceur
    2521        IF (nqtot.GT.nqo) THEN     ! jyg
    2522 !          DO iq = nqo+1, nqtot      ! jyg
    2523           DO itr=1,nqtottr      ! C Risi modif directe
    2524               d_tr_dyn(:,:,itr)=(tr_seri(:,:,itr)-tr_ancien(:,:,itr))/phys_tstep ! jyg
    2525           ENDDO
    2526        ENDIF
     2554       IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep
    25272555       ! !! RomP <<<
     2556       !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep
     2557       d_rneb_dyn(:,:)=0.0
    25282558
    25292559#ifdef ISO
    … …  
    26272657
    26282658       ! !! RomP >>>   td dyn traceur
    2629        IF (nqtot.GT.nqo) THEN                                       ! jyg
    2630 !          DO iq = nqo+1, nqtot                                      ! jyg
    2631 !              d_tr_dyn(:,:,iq-nqo)= 0.0                             ! jyg
    2632 ! Modif C Risi:
    2633           DO itr=1,nqtottr
    2634                 d_tr_dyn(:,:,itr)= 0.0
    2635           ENDDO
    2636        ENDIF
     2659       IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
     2660       d_rneb_dyn(:,:)=0.0
    26372661       ! !! RomP <<<
    26382662       ancien_ok = .TRUE.
    … …  
    30053029      ! verif iso_eau
    30063030      !write(*,*) 'physiq tmp 2748: iso_eau=',iso_eau
    3007       !write(*,*) 'use_iso=',use_iso
    30083031      !write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
    30093032      !write(*,*) 'd_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)=',d_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)
    … …  
    33633386            ENDDO
    33643387         ENDDO
    3365        ELSE !IF (iflag_wake>=1) THEN
     3388       ELSE
    33663389                t_w(:,:) = t_seri(:,:)
    33673390                q_w(:,:) = q_seri(:,:)
    … …  
    35233546     &           'physiq 1456, avant concvl')
    35243547            endif   
    3525 #endif      
     3548#endif     
    35263549      enddo !do k=1,nlev
    3527    enddo  !do i=1,klon
    3528         if (iso_eau.gt.0) then
    3529         i=1
    3530         k=1
    3531         write(*,*) 'physic 2376: xt_seri(iso_eau,i,k),q_seri(i,k)=',xt_seri(iso_eau,i,k),q_seri(i,k)
    3532         write(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
    3533         write(*,*) 'physic 2376: xt_x(iso_eau,i,k),q_x(i,k)=',xt_x(iso_eau,i,k),q_x(i,k)
    3534         write(*,*) 'xt_x(:,i,k)=',xt_x(:,i,k)
    3535         endif
    3536 #endif
     3550   enddo  !do i=1,klon   
     3551#endif
    35373552!ISOVERIF         
    35383553          if ((bidouille_anti_divergence).and. &
    … …  
    35673582          !
    35683583          !>jyg
    3569           IF (type_trac == 'repr') THEN
     3584          IF (ANY(types_trac == 'repr')) THEN
    35703585             nbtr_tmp=ntra
    35713586          ELSE
    … …  
    36103625#ifdef ISOVERIF
    36113626!          write(*,*) 'q_detrainement(1,:)=',q_detrainement(1,:)
    3612           call iso_verif_noNaN_vect2D(d_xt_con, &
     3627      call iso_verif_noNaN_vect2D(d_xt_con, &
    36133628     &           'physiq 3203a apres conv',ntraciso,klon,klev)
    3614           call iso_verif_noNaN_vect2D(xt_seri, &
    3615      &           'physiq 3203b apres conv',ntraciso,klon,klev)         
     3629      call iso_verif_noNaN_vect2D(xt_seri, &
     3630     &           'physiq 3203b apres conv',ntraciso,klon,klev)
     3631      if (iso_HDO.gt.0) then
     3632      call iso_verif_aberrant_enc_vect2D( &
     3633     &           xt_seri,q_seri, &
     3634     &           'physiq 3619a',ntraciso,klon,klev)
     3635      endif
     3636      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
     3637      call iso_verif_O18_aberrant_enc_vect2D( &
     3638     &           xt_seri,q_seri, &
     3639     &           'physiq 3619b',ntraciso,klon,klev)
     3640      endif         
    36163641#endif
    36173642#ifdef ISOVERIF
    … …  
    37503775          ! où i n'est pas un point convectif et donc ibas_con(i)=0
    37513776          ! c'est un pb indépendant des isotopes
    3752           if (ibas_con(i).gt.0) then
    3753             ema_pcb(i)  = paprs(i,ibas_con(i))
    3754           else ! if (ibas_con(i).gt.0) then
    3755               ema_pcb(i)  = 0.0
    3756           endif ! if (ibas_con(i).gt.0) then
    3757 
     3777          if (ibas_con(i) > 0) then
     3778             ema_pcb(i)  = paprs(i,ibas_con(i))
     3779          else
     3780             ema_pcb(i)  = 0.0
     3781          endif
    37583782       ENDDO
    37593783       DO i = 1, klon
    … …  
    39063930#ifdef ISO
    39073931#ifdef ISOVERIF
    3908      write(*,*) 'physiq 3425'
     3932     write(*,*) 'physiq 3425: apres convection'
    39093933      if (iso_HDO.gt.0) then
    39103934      call iso_verif_aberrant_enc_vect2D( &
    … …  
    39153939      call iso_verif_O18_aberrant_enc_vect2D( &
    39163940     &           xt_seri,q_seri, &
    3917      &           'physiq 3691a',ntraciso,klon,klev)
     3941     &           'physiq 3691b',ntraciso,klon,klev)
    39183942      endif
    39193943#ifdef ISOTRAC
    … …  
    43914415#endif         
    43924416#ifdef ISOVERIF
    4393       write(*,*) 'physiq 3691b: avant call ajsec'
     4417      write(*,*) 'physiq 3691c: avant call ajsec'
    43944418      if (iso_eau.gt.0) then
    43954419      call iso_verif_egalite_vect2D( &
    … …  
    44824506    ENDDO
    44834507
    4484    CALL  calcratqs(klon,klev,prt_level,lunout,        &
     4508    CALL  calcratqs(klon,klev,prt_level,lunout,        &
    44854509         iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
    44864510         ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
    … …  
    44904514         pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave,t2m,q2m,fm_therm, &
    44914515         ratqs,ratqsc,ratqs_inter)
    4492 
    44934516
    44944517    !
    … …  
    45854608    IF (ok_new_lscp) THEN
    45864609
    4587     CALL lscp(phys_tstep,paprs,pplay, &
     4610    CALL lscp(phys_tstep,missing_val,paprs,pplay, &
    45884611         t_seri, q_seri,ptconv,ratqs, &
    4589          d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, picefra, &
    4590          rain_lsc, snow_lsc, &
     4612         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneb_seri, &
     4613         cldliq, picefra, rain_lsc, snow_lsc, &
    45914614         pfrac_impa, pfrac_nucl, pfrac_1nucl, &
    45924615         frac_impa, frac_nucl, beta_prec_fisrt, &
    45934616         prfl, psfl, rhcl,  &
    45944617         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    4595          iflag_ice_thermo)
     4618         iflag_ice_thermo, ok_ice_sursat)
    45964619
    45974620    ELSE
    … …  
    50895112    ENDDO
    50905113
    5091     IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN      ! ModThL
     5114    IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN ! ModThL
    50925115#ifdef INCA
    50935116       CALL VTe(VTphysiq)
    … …  
    51455168#endif
    51465169    ENDIF !type_trac = inca or inco
    5147     IF (type_trac == 'repr') THEN
     5170    IF (ANY(types_trac == 'repr')) THEN
    51485171#ifdef REPROBUS
    51495172    !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
    … …  
    53345357               flwp, fiwp, flwc, fiwc, &
    53355358               mass_solu_aero, mass_solu_aero_pi, &
    5336                cldtaupi, re, fl, ref_liq, ref_ice, &
     5359               cldtaupi, latitude_deg, re, fl, ref_liq, ref_ice, &
    53375360               ref_liq_pi, ref_ice_pi)
    53385361       ELSE
    … …  
    54745497          !
    54755498          !--interactive CO2 in ppm from carbon cycle
    5476           IF (carbon_cycle_rad.AND..NOT.debut) THEN
    5477             RCO2=RCO2_glo
    5478           ENDIF
     5499          IF (carbon_cycle_rad) RCO2=RCO2_glo
    54795500          !
    54805501          IF (prt_level .GE.10) THEN
    … …  
    56065627                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
    56075628                     ZSWFT0_i, ZFSDN0, ZFSUP0)
    5608           endif !ok_4xCO2atm
     5629          ENDIF !ok_4xCO2atm
    56095630       ENDIF ! aerosol_couple
    56105631       itaprad = 0
    … …  
    62416262    !
    62426263
    6243     IF (type_trac=='repr') THEN
     6264    IF (ANY(types_trac=='repr')) THEN
    62446265!MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod
    62456266!MM                               dans Reprobus
    … …  
    63396360    ! Calculer le transport de l'eau et de l'energie (diagnostique)
    63406361    !
    6341     CALL transp (paprs,zxtsol, &
    6342          t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
    6343          ve, vq, ue, uq, vwat, uwat)
     6362    CALL transp (paprs, zxtsol, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
     6363                 ue, ve, uq, vq, uwat, vwat)
    63446364    !
    63456365    !IM global posePB BEG
    … …  
    63526372    ENDIF !(1.EQ.0) THEN
    63536373    !IM global posePB END
     6374    !
    63546375    ! Accumuler les variables a stocker dans les fichiers histoire:
    63556376    !
    … …  
    63626383    d_t_ec(:,:)=0.
    63636384    forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
    6364     CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap),qx(:,:,iliq),qx(:,:,isol), &
     6385    CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx,ivap,iliq,isol, &
    63656386         u_seri,v_seri,t_seri,q_seri,ql_seri,qs_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
    63666387         zmasse,exner,d_t_ec)
    … …  
    64076428#endif
    64086429    !
    6409     IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
     6430    IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN
    64106431#ifdef INCA
    64116432       CALL VTe(VTphysiq)
    … …  
    64546475          d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep
    64556476          !CR: on ajoute le contenu en glace
    6456           IF (nqo.eq.3) THEN
     6477          IF (nqo.ge.3) THEN
    64576478             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
     6479          ENDIF
     6480          !--ice_sursat: nqo=4, on ajoute rneb
     6481          IF (nqo.eq.4) THEN
     6482             d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
    64586483          ENDIF
    64596484       ENDDO
    … …  
    64656490      DO k = 1, klev
    64666491       DO i = 1, klon
    6467           iq=iqiso(ixt,ivap)
     6492          iq=iqIsoPha(ixt,ivap)
    64686493          d_qx(i,k,iq) = ( xt_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
    6469           iq=iqiso(ixt,iliq)
     6494          iq=iqIsoPha(ixt,iliq)
    64706495          d_qx(i,k,iq) = ( xtl_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
    64716496          if (nqo.eq.3) then
    6472              iq=iqiso(ixt,isol)
     6497             iq=iqIsoPha(ixt,isol)
    64736498             d_qx(i,k,iq) = ( xts_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
    64746499          endif
    … …  
    64836508#endif
    64846509! #ifdef ISO
    6485     !
    6486     !CR: nb de traceurs eau: nqo
    6487     !  IF (nqtot.GE.3) THEN
    6488     IF (nqtot.GE.(nqo+1)) THEN
    6489        !     DO iq = 3, nqtot
    6490 !       DO iq = nqo+1, nqtot ! modif C Risi
    6491         do itr=1,nqtottr
    6492          iq=itr_indice(itr)
    6493           DO  k = 1, klev
    6494              DO  i = 1, klon
    6495                 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / phys_tstep
    6496                 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / phys_tstep
    6497              ENDDO
     6510    ! DC: All iterations are cycled if nqtot==nqo, so no nqtot>nqo condition required
     6511    itr = 0
     6512    DO iq = 1, nqtot
     6513       IF(.NOT.tracers(iq)%isInPhysics) CYCLE
     6514       itr = itr+1
     6515       DO  k = 1, klev
     6516          DO  i = 1, klon
     6517             d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep
    64986518          ENDDO
    6499        ENDDO ! !do itr=1,nqtottr
    6500     ENDIF
     6519       ENDDO
     6520    ENDDO
    65016521    !
    65026522    !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
    … …  
    65566576    CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
    65576577    ! !! RomP >>>
    6558     !CR: nb de traceurs eau: nqo
    6559     IF (nqtot.GT.nqo) THEN
    6560        ! DO iq = nqo+1, nqtot ! modif C Risi
    6561        do itr=1,nqtottr
    6562           tr_ancien(:,:,itr) = tr_seri(:,:,itr)
    6563        ENDDO
    6564     ENDIF
     6578    IF (nqtot > nqo) tr_ancien(:,:,:) = tr_seri(:,:,:)
    65656579    ! !! RomP <<<
    65666580    !==========================================================================
    … …  
    67836797            endif ! if (iso_eau.gt.0) then
    67846798#ifdef ISOTRAC
    6785             if (ok_isotrac) then     
    6786             call iso_verif_traceur(xt_ancien(1,i,k),'physiq 4802')
    6787             endif !if (ok_isotrac) then
     6799            IF(nzone > 0) CALL iso_verif_traceur(xt_ancien(1,i,k),'physiq 4802')
    67886800#endif         
    67896801          enddo
    … …  
    67936805! ISO
    67946806
     6807    ! Disabling calls to the prt_alerte function
     6808    alert_first_call = .FALSE.
     6809   
    67956810    IF (lafin) THEN
    67966811       itau_phy = itau_phy + itap

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/reevap.F90

    r3927 r4368  
    99    USE add_phys_tend_mod, only : fl_cor_ebil
    1010#ifdef ISO
    11     USE infotrac_phy, ONLY: ntraciso   
     11    USE infotrac_phy, ONLY: ntiso   
    1212#ifdef ISOVERIF
    1313    USE isotopes_verif_mod
    … …  
    3030
    3131#ifdef ISO
    32     REAL, DIMENSION(ntraciso,klon,klev), INTENT(in) :: xt_seri,xtl_seri,xts_seri
    33     REAL, DIMENSION(ntraciso,klon,klev), INTENT(out) :: d_xt_eva,d_xtl_eva,d_xts_eva
     32    REAL, DIMENSION(ntiso,klon,klev), INTENT(in) :: xt_seri,xtl_seri,xts_seri
     33    REAL, DIMENSION(ntiso,klon,klev), INTENT(out) :: d_xt_eva,d_xtl_eva,d_xts_eva
    3434    integer ixt
    3535#endif
    … …  
    7676
    7777#ifdef ISO
    78          do ixt=1,ntraciso
     78         do ixt=1,ntiso
    7979            zb = MAX(0.0,xtl_seri(ixt,i,k))
    8080            d_xt_eva(ixt,i,k) = zb
    8181            d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k)
    8282            d_xts_eva(ixt,i,k) = 0.
    83          enddo ! do ixt=1,ntraciso
     83         enddo
    8484#ifdef ISOVERIF
    85       do ixt=1,ntraciso
     85      do ixt=1,ntiso
    8686        call iso_verif_noNaN(xt_seri(ixt,i,k), &
    8787     &     'physiq 2417: apres evap tot')
    … …  
    136136
    137137#ifdef ISO
    138          do ixt=1,ntraciso
     138         do ixt=1,ntiso
    139139            zb = MAX(0.0,xtl_seri(ixt,i,k)+xts_seri(ixt,i,k))
    140140            d_xt_eva(ixt,i,k) = zb
    141141            d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k)
    142142            d_xts_eva(ixt,i,k) = -xts_seri(ixt,i,k)
    143          enddo ! do ixt=1,ntraciso
     143         enddo
    144144
    145145#ifdef ISOVERIF
    146       do ixt=1,ntraciso
     146      do ixt=1,ntiso
    147147      call iso_verif_noNaN(xt_seri(ixt,i,k), &
    148148     &     'physiq 2417: apres evap tot')

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/surf_land_bucket_mod.F90

    r3975 r4368  
    3535    USE indice_sol_mod
    3636#ifdef ISO
    37     use infotrac_phy, ONLY: ntraciso,niso
     37    use infotrac_phy, ONLY: ntiso,niso
    3838    USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
    3939        ridicule_qsol
    … …  
    6969    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
    7070#ifdef ISO
    71     REAL, DIMENSION(ntraciso,klon), INTENT(IN)      :: xtprecip_rain, xtprecip_snow
    72     REAL, DIMENSION(ntraciso,klon), INTENT(IN)      :: xtspechum   
     71    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
     72    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum   
    7373#endif
    7474
    … …  
    9191    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l         
    9292#ifdef ISO
    93     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)      :: xtevap
    94     REAL, DIMENSION(klon), INTENT(OUT)      :: h1
    95     REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrunoff_diag
    96     REAL, DIMENSION(klon), INTENT(OUT)      :: runoff_diag
    97     REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
     93    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
     94    REAL, DIMENSION(klon),       INTENT(OUT) :: h1
     95    REAL, DIMENSION(niso,klon),  INTENT(OUT) :: xtrunoff_diag
     96    REAL, DIMENSION(klon),       INTENT(OUT) :: runoff_diag
     97    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
    9898#endif
    9999
    … …  
    128128#ifdef ISO
    129129#ifdef ISOVERIF
    130         write(*,*) 'surf_land_bucket 152'
     130        !write(*,*) 'surf_land_bucket 152'
    131131        do i=1,knon
    132132          if (iso_eau.gt.0) then
    … …  
    146146         enddo !do ixt=1,niso
    147147        enddo !do i=1,knon
    148         write(*,*) 'surf_land_bucket 152'
     148        !write(*,*) 'surf_land_bucket 152'
    149149#endif
    150150#endif
    … …  
    211211   ! verif
    212212#ifdef ISOVERIF
    213     write(*,*) 'surf_land_bucket 211'
     213    !write(*,*) 'surf_land_bucket 211'
    214214    do i=1,knon
    215215      if (iso_eau.gt.0) then
    … …  
    236236   enddo !do i=1,knon
    237237#ifdef ISOVERIF
    238         write(*,*) 'surf_land_bucket 235'
     238       ! write(*,*) 'surf_land_bucket 235'
    239239       do i=1,knon 
    240240        if (iso_eau.gt.0) then
    … …  
    243243        endif
    244244      enddo !do i=1,knon
    245         write(*,*) 'snow_prec(1)=',snow_prec(1)
    246         write(*,*) 'xtsnow(:,1)=',xtsnow(:,1)
    247245#endif   
    248246#endif   
    … …  
    261259#ifdef ISO
    262260#ifdef ISOVERIF
    263         write(*,*) 'surf_land_bucket 258'
    264         write(*,*) 'snow_prec(1)=',snow_prec(1)
    265         write(*,*) 'xtsnow(:,1)=',xtsnow(:,1)
    266261        do i=1,knon
    267262         do ixt=1,niso
    … …  
    271266#endif
    272267#ifdef ISOVERIF
    273         write(*,*) 'surf_land_bucket 235'
     268        !write(*,*) 'surf_land_bucket 235'
    274269        do i=1,knon
    275270          if (iso_eau.gt.0) then
    … …  
    297292          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
    298293        enddo  !do i=1,knon
    299         write(*,*) 'surf_land_mod 291'
    300         write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
     294        !write(*,*) 'surf_land_mod 291'
     295        !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
    301296#endif         
    302297        call calcul_iso_surf_ter_vectall(klon,knon, &

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/surf_land_mod.F90

    r3927 r4368  
    3030    USE dimphy
    3131    USE surface_data, ONLY    : ok_veget
    32 ! >> PC
    3332    USE carbon_cycle_mod
    34 ! << PC
    3533
    3634    ! See comments in each module surf_land_orchidee_xxx for compatiblity with ORCHIDEE
    … …  
    5149    USE surf_land_orchidee_nounstruct_mod
    5250#else
     51#if ORCHIDEE_NOLIC
     52    ! Compilation with cpp key ORCHIDEE_NOLIC
     53    USE surf_land_orchidee_nolic_mod
     54#else
     55    ! Default version#else
    5356    USE surf_land_orchidee_mod
     57#endif
    5458#endif
    5559#endif
    … …  
    6165    USE indice_sol_mod
    6266#ifdef ISO
    63     use infotrac_phy, ONLY: ntraciso,niso
     67    use infotrac_phy, ONLY: ntiso,niso
    6468    use isotopes_mod, ONLY: nudge_qsol, iso_eau
    6569#ifdef ISOVERIF
    … …  
    6771#endif
    6872#endif
    69 
    70 ! >> PC
     73   
    7174    USE print_control_mod, ONLY: lunout
    72 ! << PC
    7375
    7476    INCLUDE "dimsoil.h"
    … …  
    104106    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
    105107#ifdef ISO
    106     REAL, DIMENSION(ntraciso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
    107     REAL, DIMENSION(ntraciso,klon), INTENT(IN)       :: xtspechum
     108    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
     109    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
    108110#endif
    109111
    … …  
    135137    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
    136138#ifdef ISO
    137     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)      :: xtevap
     139    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
    138140    REAL, DIMENSION(klon), INTENT(OUT)      :: h1
    139141    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrunoff_diag
    … …  
    166168#ifdef ISO
    167169#ifdef ISOVERIF
    168         write(*,*) 'surf_land_mod 162'
     170!        write(*,*) 'surf_land_mod 162'
    169171        do i=1,knon
    170172          if (iso_eau.gt.0) then
    … …  
    179181#endif
    180182#ifdef ISOVERIF
    181        write(*,*) 'surf_land 169: ok_veget=',ok_veget
     183!       write(*,*) 'surf_land 169: ok_veget=',ok_veget
    182184        do i=1,knon
    183          do ixt=1,ntraciso
     185         do ixt=1,ntiso
    184186           call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
    185187         enddo
    … …  
    262264#ifdef ISO
    263265#ifdef ISOVERIF
    264        write(*,*) 'surf_land 247'
     266!       write(*,*) 'surf_land 247'
    265267        call iso_verif_egalite_vect1D( &
    266268     &           xtsnow,snow,'surf_land_mod 207',niso,klon)
    … …  
    306308#ifdef ISO
    307309#ifdef ISOVERIF
    308      write(*,*) 'surf_land 237: sortie'   
     310!     write(*,*) 'surf_land 237: sortie'   
    309311     do i=1,knon
    310312        if (iso_eau.gt.0) then

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/surf_landice_mod.F90

    r3975 r4368  
    3737#ifdef ISO   
    3838    USE fonte_neige_mod,  ONLY : xtrun_off_lic
    39     USE infotrac_phy, ONLY : ntraciso,niso
     39    USE infotrac_phy, ONLY : ntiso,niso
    4040    USE isotopes_routines_mod, ONLY: calcul_iso_surf_lic_vectall
    4141#ifdef ISOVERIF
    … …  
    8282    REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
    8383#ifdef ISO
    84     REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
    85     REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtspechum
     84    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
     85    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
    8686#endif
    8787
    … …  
    129129    REAL, DIMENSION(klon), INTENT(OUT)           :: runoff  !Land ice runoff
    130130#ifdef ISO
    131     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)        :: xtevap     
     131    REAL, DIMENSION(ntiso,klon), INTENT(OUT)     :: xtevap     
    132132!    real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
    133133!    fonte_neige
    … …  
    144144    INTEGER                  :: i,j,nt
    145145    REAL, DIMENSION(klon)    :: fqfonte,ffonte
     146    REAL, DIMENSION(klon)    :: run_off_lic_frac
    146147#ifdef ISO       
    147148      real, parameter :: t_coup = 273.15
    … …  
    375376   ! verif
    376377#ifdef ISOVERIF
    377      write(*,*) 'surf_land_ice 1499'   
     378     !write(*,*) 'surf_land_ice 1499'   
    378379     do i=1,knon
    379380       if (iso_eau.gt.0) then
    … …  
    484485! Send run-off on land-ice to coupler if coupled ocean.
    485486! run_off_lic has been calculated in fonte_neige or surf_inlandsis
    486 !
    487 !****************************************************************************************
    488     IF (type_ocean=='couple') THEN
    489        CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic)
     487! If landice_opt>=2, corresponding call is done from surf_land_orchidee
     488!****************************************************************************************
     489    IF (type_ocean=='couple' .AND. landice_opt .LT. 2) THEN
     490       ! Compress fraction where run_off_lic is active (here all pctsrf(is_lic))
     491       run_off_lic_frac(:)=0.0
     492       DO j = 1, knon
     493          i = knindex(j)
     494          run_off_lic_frac(j) = pctsrf(i,is_lic)
     495       ENDDO
     496       
     497       CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic, run_off_lic_frac)
    490498    ENDIF
    491499

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/surf_ocean_mod.F90

    r3940 r4368  
    3737    USE indice_sol_mod, ONLY : nbsrf, is_oce
    3838#ifdef ISO
    39   USE infotrac_phy, ONLY : ntraciso,niso
     39  USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
    4040#ifdef ISOVERIF
    4141    USE isotopes_mod, ONLY: iso_eau,ridicule

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/surf_seaice_mod.F90

    r3940 r4368  
    3535  USE indice_sol_mod
    3636#ifdef ISO
    37   USE infotrac_phy, ONLY : ntraciso,niso
     37  USE infotrac_phy, ONLY : ntiso,niso
    3838#endif
    3939
    … …  
    7171    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
    7272#ifdef ISO
    73     REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
     73    REAL, DIMENSION(ntiso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
    7474    REAL, DIMENSION(klon), INTENT(IN)        :: xtspechum
    7575    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Roce
    … …  
    101101    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    102102#ifdef ISO
    103     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)        :: xtevap 
     103    REAL, DIMENSION(ntiso,klon), INTENT(OUT)        :: xtevap 
    104104#endif
    105105

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/wake.F90

    r3927 r4368  
    3434  USE print_control_mod, ONLY: prt_level
    3535#ifdef ISO
    36   USE infotrac_phy, ONLY : ntraciso
     36  USE infotrac_phy, ONLY : ntraciso=>ntiso
    3737#ifdef ISOVERIF
    3838  USE isotopes_verif_mod
    … …  
    355355
    356356  ! print*, 'wake initialisations'
    357 #ifdef ISOVERIF
    358         write(*,*) 'wake 358: entree'
    359 #endif
     357!#ifdef ISOVERIF
     358!        write(*,*) 'wake 358: entree'
     359!#endif
    360360
    361361  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
    … …  
    497497  ! ------------------------------------------------------------------------
    498498
    499 #ifdef ISOVERIF
    500         write(*,*) 'wake 500: debut inits'
    501 #endif
    502499!jyg<
    503500!!  DO k = 1, klev
    … …  
    549546#endif
    550547
    551 #ifdef ISOVERIF
    552         write(*,*) 'wake 552: milieu inits'
    553 #endif
    554548      IF (iflag_wk_act == 0) THEN
    555549        act(:) = 0.
Note: See TracChangeset for help on using the changeset viewer.