Ignore:
Timestamp:
Jul 1, 2024, 11:25:05 AM (5 days ago)
Author:
dcugnet
Message:
  • strings_mod:
    • remove "test()" function (was not very clear)
    • modifications of the "str2bool" function: result is O/1 for .FALSE./.TRUE. and -1 if the string was not a boolean.
    • more general "find()" function (for several numerical types)
    • more general "cat()" function (can append a 2D array with vectors, 1D arrays with scalars)
    • few simplifications (in "strParse") and minor changes
  • readTracFiles_mod:
    • remove internal usage of direct keys ("%" symbol) in favor of the "getKey" function. => moving toward a totally generic tracers derived type.
    • improve the internal management of the error return value "lerr".
    • remove "fGetKey", "fGetKeys", "setDirectKeys" functions
    • new functions to add/remove a phase: "addPhase", "delPhase"
    • more general "addKey(key[(:)], val[(:)], ky(:), [lOverWrite])" function: . input argument "val" can be string/integer/real/logical . (key, val, ky ): add the <key> =<val> pair to ky . (key, val(:), ky(:)): add the <key> =<val(i)> pair to ky(i) for 1<=i<=SIZE(ky) . (key(:), val(:), ky(:)): add the <key(i)>=<val(i)> pair to ky(i) for 1<=i<=SIZE(ky)
    • more general "getKey(key[(:)], val[(:)], itr [, ky(:)][, nam(:)][, def][, lDisp])" (tracer index version)

and "getKey(key[(:)], val[(:)], tname[, ky(:)]. [, def][, lDisp])" (tracer name version) functions:

. output argument "val" can be string/integer/real/logical
. if present, the default value <def> is retained if the corresponding key was not found.
. get values from "ky(:)" if present, otherwise from internal database "tracers(:)" or "isotope ».
. if "keyn" is a vector, try with each element in indices order until a value is found
. (key[(:)], val, itr/tname[,ky(:)][, ...]): get the value <val> of tracer nr. itr or named "tname"
. (key[(:)], val(:), itr/tname[,ky(:)][, ...]): same + parsing of the value with « , », then storage in <val(:)>
. (key[(:)], val(:)[, ky(:)][, nam(:)][, ...]): same for all tracers (optional names list <nam(:)>) of database.
. (key[(:)], val(:), tname(:)[, ky(:)][, ...]): same for the tracers named « tnames(:)"

  • more general "dispTraSection" function
  • much simplified "indexUpdate" function ; "ancestor*" and "idxAncestor" functions are removed.
  • "readIsotopesFile" is renamed to "processIsotopes" for more clarity
  • cosmetic changes
  • fix for isotopes: iq_val and iq_liq are usable for "q" only, not for "q_follow" and "zx_defau_diag" => use hardcoded indices (1 for vapor and 2 for liquid) for these variables
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r4469 r5001  
    3131c     .................................................................
    3232c
     33cDC iq_val and iq_liq are usable for q only, NOT for q_follow
     34c   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
     35c   water at hardcoded indices 1/2 in these variables
    3336      INTEGER i, k, iq
    3437      REAL zx_defau, zx_abc, zx_pump(ijb_u:ije_u), pompe
    … …  
    4952      INTEGER ixt
    5053      INTEGER iso_verif_noNaN_nostop
    51 c
    52 c Quand l'eau liquide est trop petite (ou negative), on prend
    53 c l'eau vapeur de la meme couche et la convertit en eau liquide
    54 c (sans changer la temperature !)
    55 c
    5654
    5755c$OMP BARRIER
    … …  
    6361         first = .FALSE.
    6462      END IF
     63c
     64c Quand l'eau liquide est trop petite (ou negative), on prend
     65c l'eau vapeur de la meme couche et la convertit en eau liquide
     66c (sans changer la temperature !)
     67c
     68
    6569      call check_isotopes(q,ij_begin,ij_end,'qminimum 52')   
    6670
    … …  
    7377          zx_defau_diag(i,k,1)=0.0
    7478          zx_defau_diag(i,k,2)=0.0
    75           q_follow(i,k,1)=q(i,k,1)
    76           q_follow(i,k,2)=q(i,k,2)
     79          q_follow(i,k,1)=q(i,k,iq_vap)
     80          q_follow(i,k,2)=q(i,k,iq_liq)
    7781        ENDDO
    7882c$OMP END DO NOWAIT
    … …  
    8084
    8185      !write(lunout,*) 'qminimum 57'
    82       DO 1000 k = 1, llm
     86      DO k = 1, llm
    8387c$OMP DO SCHEDULE(STATIC)       
    84       DO 1040 i = ijb, ije
    85             if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
    86 
    87               if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1
     88        DO i = ijb, ije
     89          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
     90
     91            if (niso > 0) zx_defau_diag(i,k,2)=AMAX1
    8892     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
    8993
    90                q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
    91                q(i,k,iq_liq) = seuil_liq
    92             endif
    93  1040 CONTINUE
    94 c$OMP END DO NOWAIT
    95  1000 CONTINUE
     94            q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
     95            q(i,k,iq_liq) = seuil_liq
     96          endif
     97        END DO
     98c$OMP END DO NOWAIT
     99      END DO
    96100
    97101c
    … …  
    100104c
    101105      !write(lunout,*) 'qminimum 81'
    102       iq = iq_vap
    103 c
    104106      DO k = llm, 2, -1
    105107ccc      zx_abc = dpres(k) / dpres(k-1)
    106108c$OMP DO SCHEDULE(STATIC)
    107       DO i = ijb, ije
    108 
    109          if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
    110 
    111             if (niso > 0)
    112      &        zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
    113 
    114             q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
    115      &           deltap(i,k) / deltap(i,k-1)
    116             q(i,k,iq)   =  seuil_vap 
    117 
    118          endif
    119       ENDDO
     109        DO i = ijb, ije
     110
     111          if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then
     112
     113            if (niso > 0) zx_defau_diag(i,k,1)
     114     &           = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
     115
     116            q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap
     117     &           -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1)
     118            q(i,k,iq_vap)   =  seuil_vap 
     119
     120          endif
     121        ENDDO
    120122c$OMP END DO NOWAIT
    121123      ENDDO
    … …  
    129131c$OMP DO SCHEDULE(STATIC)
    130132      DO i = ijb, ije
    131          zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
    132          q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
     133         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) )
     134         q(i,1,iq_vap)  = AMAX1( q(i,1,iq_vap), seuil_vap )
    133135         IF (zx_pump(i) > 0.0) THEN
    134136            nb_pump = nb_pump+1
    … …  
    165167      DO i = ijb, ije
    166168        if (zx_pump(i).gt.0.0) then
    167           q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)
     169          q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
    168170        endif !if (zx_pump(i).gt.0.0) then
    169171      enddo !DO i = ijb, ije 
    … …  
    175177c$OMP DO SCHEDULE(STATIC)     
    176178        DO i = ijb, ije
    177           if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
     179          if (zx_defau_diag(i,k,1).gt.0.0) then             
    178180              ! on ajoute la vapeur en k     
    179 !              write(lunout,*) 'i,k,q_follow(i,k-1,iq_vap)=',
    180 !     :                 i,k,q_follow(i,k-1,iq_vap)         
    181               if (q_follow(i,k-1,iq_vap).lt.min_qParent) then
     181!              write(lunout,*) 'i,k,q_follow(i,k-1,ivap)=',
     182!     :                 i,k,q_follow(i,k-1,1)         
     183              if (q_follow(i,k-1,1).lt.min_qParent) then
    182184                write(lunout,*) 'tmp qmin: on stoppe'
    183185                write(lunout,*) 'zx_pump(i)=',zx_pump(i)
    184                 write(lunout,*) 'q_follow(i,:,iq_vap)=',
    185      :                   q_follow(i,:,iq_vap)
     186                write(lunout,*) 'q_follow(i,:,ivap)=',
     187     :                   q_follow(i,:,1)
    186188                write(lunout,*) 'k=',k
    187189                call abort_gcm("qminimum","not enough vapor",1)
    … …  
    189191            do ixt=1,ntiso
    190192!                write(lunout,*) 'qmin 168: ixt=',ixt
    191 !                write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap)=',
     193!                write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
    192194!     :             q(i,k,iqIsoPha(ixt,iq_vap))
    193 !                write(lunout,*) 'zx_defau_diag(i,k,iq_vap)=',
    194 !     :                  zx_defau_diag(i,k,iq_vap)
    195 !                write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap)=',
     195!                write(lunout,*) 'zx_defau_diag(i,k,ivap)=',
     196!     :                  zx_defau_diag(i,k,1)
     197!                write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
    196198!     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))     
    197199
    198200               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    199      :           +zx_defau_diag(i,k,iq_vap)
    200      :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     201     :           +zx_defau_diag(i,k,1)
     202     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
    201203               
    202204              if (isoCheck) then
    … …  
    204206     :                   'qminimum 155').eq.1) then
    205207                   write(*,*) 'i,k,ixt=',i,k,ixt
    206                    write(*,*) 'q_follow(i,k-1,iq_vap)=',
    207      :                   q_follow(i,k-1,iq_vap)
     208                   write(*,*) 'q_follow(i,k-1,ivap)=',
     209     :                   q_follow(i,k-1,1)
    208210                   write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
    209211     :                   q(i,k,iqIsoPha(ixt,iq_vap))
    210                    write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
    211      :                   zx_defau_diag(i,k,iq_vap)
     212                   write(*,*) 'zx_defau_diag(i,k,ivap)=',
     213     :                   zx_defau_diag(i,k,1)
    212214                   write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
    213215     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
    … …  
    219221               q(i,k-1,iqIsoPha(ixt,iq_vap)) =
    220222     :            q(i,k-1,iqIsoPha(ixt,iq_vap))
    221      :              -zx_defau_diag(i,k,iq_vap)
     223     :              -zx_defau_diag(i,k,1)
    222224     :              *deltap(i,k)/deltap(i,k-1)
    223225     :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
    224      :              /q_follow(i,k-1,iq_vap)
     226     :              /q_follow(i,k-1,1)
    225227
    226228               if (isoCheck) then
    … …  
    229231     :                   'qminimum 175').eq.1) then
    230232                   write(*,*) 'k,i,ixt=',k,i,ixt
    231                    write(*,*) 'q_follow(i,k-1,iq_vap)=',
    232      :                   q_follow(i,k-1,iq_vap)
     233                   write(*,*) 'q_follow(i,k-1,ivap)=',
     234     :                   q_follow(i,k-1,1)
    233235                   write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
    234236     :                   q(i,k,iqIsoPha(ixt,iq_vap))
    235                    write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
    236      :                   zx_defau_diag(i,k,iq_vap)
     237                   write(*,*) 'zx_defau_diag(i,k,ivap)=',
     238     :                   zx_defau_diag(i,k,1)
    237239                   write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
    238240     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
    … …  
    242244
    243245              enddo !do ixt=1,niso
    244               q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
    245      :               +zx_defau_diag(i,k,iq_vap)
    246               q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
    247      :               -zx_defau_diag(i,k,iq_vap)
     246              q_follow(i,k,1)=   q_follow(i,k,1)
     247     :               +zx_defau_diag(i,k,1)
     248              q_follow(i,k-1,1)=   q_follow(i,k-1,1)
     249     :               -zx_defau_diag(i,k,1)
    248250     :              *deltap(i,k)/deltap(i,k-1)
    249           endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
     251          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
    250252        enddo !DO i = 1, ip1jmp1       
    251253c$OMP END DO NOWAIT
    … …  
    260262c$OMP DO SCHEDULE(STATIC)
    261263        DO i = ijb, ije
    262           if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
     264          if (zx_defau_diag(i,k,2).gt.0.0) then
    263265
    264266              ! on ajoute eau liquide en k en k             
    265267              do ixt=1,ntiso
    266268               q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
    267      :              +zx_defau_diag(i,k,iq_liq)
    268      :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
     269     :              +zx_defau_diag(i,k,2)
     270     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
    269271              ! et on la retranche à la vapeur en k
    270272               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    271      :              -zx_defau_diag(i,k,iq_liq)
    272      :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
     273     :              -zx_defau_diag(i,k,2)
     274     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)   
    273275              enddo !do ixt=1,niso
    274               q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
    275      :               +zx_defau_diag(i,k,iq_liq)
    276               q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
    277      :               -zx_defau_diag(i,k,iq_liq)
    278           endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
     276              q_follow(i,k,2)=   q_follow(i,k,2)
     277     :               +zx_defau_diag(i,k,2)
     278              q_follow(i,k,1)=   q_follow(i,k,1)
     279     :               -zx_defau_diag(i,k,2)
     280          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
    279281        enddo !DO i = ijb, ije
    280282c$OMP END DO NOWAIT       
Note: See TracChangeset for help on using the changeset viewer.