Ignore:
Timestamp:
Sep 3, 2023, 10:08:39 AM (10 months ago)
Author:
fhourdin
Message:

Replayisation lmdz_lscp_old

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/lmdz_lscp_old.F90

    r4664 r4666  
    44MODULE lmdz_lscp_old
    55CONTAINS
    6 SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs, &
    7      d_t, d_q, d_ql, d_qi, rneb, radliq, rain, snow,          &
     6SUBROUTINE fisrtilp(klon,klev,dtime,paprs,pplay,t,q,ptconv,ratqs, &
     7     d_t, d_q, d_ql, d_qi, rneb,rneblsvol,radliq, rain, snow,          &
    88     pfrac_impa, pfrac_nucl, pfrac_1nucl,               &
    99     frac_impa, frac_nucl, beta,                        &
    1010     prfl, psfl, rhcl, zqta, fraca,                     &
    1111     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
    12      iflag_ice_thermo)
    13 
    14   !
    15   USE dimphy
     12     iflag_ice_thermo,                                  &
     13     cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
     14
     15
     16  !
    1617  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
    17   USE print_control_mod, ONLY: prt_level, lunout
    1818  USE lmdz_cloudth, only : cloudth, cloudth_v3, cloudth_v6
    19   USE ioipsl_getin_p_mod, ONLY : getin_p
    20   USE phys_local_var_mod, ONLY: ql_seri,qs_seri
    21   USE phys_local_var_mod, ONLY: rneblsvol
    22   ! flag to include modifications to ensure energy conservation (if flag >0)
    23   USE add_phys_tend_mod, only : fl_cor_ebil
     19
     20  USE lmdz_lscp_ini, ONLY: prt_level, lunout
     21  USE lmdz_lscp_ini, ONLY : fl_cor_ebil
    2422  USE lmdz_lscp_ini, ONLY: iflag_t_glace,t_glace_min, t_glace_max, exposant_glace
     23  USE lmdz_lscp_ini, ONLY : seuil_neb, rain_int_min, iflag_evap_prec, iflag_oldbug_fisrtilp,a_tr_sca
    2524  USE lmdz_lscp_ini, ONLY: iflag_cloudth_vert, iflag_rain_incloud_vol
    2625  USE lmdz_lscp_ini, ONLY: coef_eva, coef_eva_i, ffallv_lsc, ffallv_con
    2726  USE lmdz_lscp_ini, ONLY: cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
    2827  USE lmdz_lscp_ini, ONLY: reevap_ice, iflag_bergeron, iflag_fisrtilp_qsat, iflag_pdf
    29       use phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv
    30       use phys_output_var_mod, ONLY : cloudth_sigmath,cloudth_sigmaenv
    3128
    3229
    … …  
    6360  !
    6461  REAL, INTENT(IN)                              :: dtime  ! intervalle du temps (s)
     62  INTEGER, INTENT(IN)                           :: klon, klev
    6563  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs  ! pression a inter-couche
    6664  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay  ! pression au milieu de couche
    … …  
    8785  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_ql ! incrementation de l'eau liquide
    8886  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_qi ! incrementation de l'eau glace
    89   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneb ! fraction nuageuse
     87  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneb, rneblsvol ! fraction nuageuse
    9088  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radliq ! eau liquide utilisee dans rayonnements
    9189  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rhcl ! humidite relative en ciel clair
    … …  
    107105  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa
    108106  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl
     107  REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_sth,cloudth_senv
     108  REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_sigmath,cloudth_sigmaenv
    109109  !AA
    110110  ! --------------------------------------------------------------------------------
    … …  
    112112  ! Options du programme:
    113113  !
    114   REAL, SAVE :: seuil_neb=0.001 ! un nuage existe vraiment au-dela
    115   !$OMP THREADPRIVATE(seuil_neb)
    116 
    117   !<LTP
    118   REAL smallestreal
    119   REAL, SAVE :: rain_int_min=0.001 !intensité locale minimum pour la pluie avant diminution de la fraction précipitante associée = 0.001 mm/s
    120   !>LTP 
    121   !$OMP THREADPRIVATE(rain_int_min)
    122 
    123 
    124   INTEGER ninter ! sous-intervals pour la precipitation
    125   PARAMETER (ninter=5)
    126   INTEGER,SAVE :: iflag_evap_prec=1 ! evaporation de la pluie
    127   !$OMP THREADPRIVATE(iflag_evap_prec)
    128   !
    129   LOGICAL cpartiel ! condensation partielle
    130   PARAMETER (cpartiel=.TRUE.)
    131   REAL t_coup
    132   PARAMETER (t_coup=234.0)
    133   REAL DDT0
    134   PARAMETER (DDT0=.01)
    135   REAL ztfondue
    136   PARAMETER (ztfondue=278.15)
     114
     115  REAL :: smallestreal
     116
     117  INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation
     118  LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle
     119  REAL, PARAMETER :: t_coup=234.0
     120  REAL, PARAMETER :: DDT0=.01
     121  REAL, PARAMETER :: ztfondue=278.15
    137122  ! --------------------------------------------------------------------------------
    138123  !
    139124  ! Variables locales:
    140125  !
    141   INTEGER i, k, n, kk
    142   INTEGER,save::itap=0
    143   !$OMP THREADPRIVATE(itap)
    144 
    145   REAL qsl, qsi
    146   real zct      ,zcl
    147   INTEGER ncoreczq 
    148   REAL ctot(klon,klev)
    149   REAL ctot_vol(klon,klev)
    150   REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5 
    151   REAL zdqsdT_raw(klon)
    152   REAL Tbef(klon),qlbef(klon),DT(klon),num,denom
    153 
    154   logical lognormale(klon)
    155   logical ice_thermo
    156   LOGICAL convergence(klon)
    157   INTEGER n_i(klon), iter
    158   REAL cste
    159 
    160   real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
    161   real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
    162   real erf   
    163   REAL qcloud(klon)
     126  INTEGER :: i, k, n, kk
     127  REAL :: qsl, qsi
     128  REAL :: zct      ,zcl
     129  INTEGER :: ncoreczq 
     130  REAL, DIMENSION(klon,klev) :: ctot,ctot_vol
     131  REAL, DIMENSION(klon) :: zqs, zdqs, zdqsdT_raw, Tbef,qlbef,DT
     132  REAL :: zdelta, zcor, zcvm5 
     133  REAL ::num,denom
     134
     135  LOGICAL, DIMENSION(klon) :: lognormale,convergence
     136  LOGICAL :: ice_thermo
     137  INTEGER, DIMENSION(klon) :: n_i
     138  INTEGER :: iter
     139  REAL :: cste
     140
     141  REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta, Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2, qcloud
     142  REAL :: erf   
    164143 
    165   REAL zrfl(klon), zrfln(klon), zqev, zqevt
    166 !<LTP
    167   REAL zrflclr(klon), zrflcld(klon)
    168   REAL d_zrfl_clr_cld(klon), d_zifl_clr_cld(klon)
    169   REAL d_zrfl_cld_clr(klon), d_zifl_cld_clr(klon)
    170 !>LTP
    171 
    172   REAL zifl(klon), zifln(klon), zqev0,zqevi, zqevti
    173 !<LTP
    174   REAL ziflclr(klon), ziflcld(klon)
    175 !>LTP
    176   REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
    177   REAL zoliqp(klon), zoliqi(klon)
    178   REAL zt(klon)
     144  REAL :: zqev, zqevt, zqev0,zqevi, zqevti, zdelq
     145  REAL, DIMENSION(klon) :: zrfl(klon), zrfln(klon), zrflclr(klon), zrflcld(klon), d_zrfl_clr_cld(klon), d_zifl_clr_cld(klon), d_zrfl_cld_clr(klon), d_zifl_cld_clr(klon)
     146
     147  REAL, DIMENSION(klon) :: zifl, zifln, ziflclr, ziflcld, zoliq, zcond, zq, zqn, zoliqp, zoliqi, zt
    179148! JBM (3/14) nexpo is replaced by exposant_glace
    180149! REAL nexpo ! exponentiel pour glace/eau
    181150! INTEGER, PARAMETER :: nexpo=6
    182   INTEGER exposant_glace_old
    183   REAL t_glace_min_old
    184   REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
    185   REAL zchau      ,zfroi      ,zfice(klon),zneb(klon),znebprecip(klon)
    186 !<LTP
    187   REAL znebprecipclr(klon), znebprecipcld(klon)
    188   REAL tot_zneb(klon), tot_znebn(klon), d_tot_zneb(klon)
    189   REAL d_znebprecip_clr_cld(klon), d_znebprecip_cld_clr(klon)
    190 !>LTP
    191 
    192   REAL zmelt, zpluie, zice
    193   REAL dzfice(klon)
    194   REAL zsolid
     151  INTEGER :: exposant_glace_old
     152  REAL :: t_glace_min_old, ztot
     153  REAL, DIMENSION(klon) ::  zdz,zrho , zrhol, zfice,zneb,znebprecip
     154  REAL :: zchau      ,zfroi     
     155  REAL, DIMENSION(klon) :: znebprecipclr, znebprecipcld, tot_zneb, tot_znebn, d_tot_zneb, d_znebprecip_clr_cld, d_znebprecip_cld_clr, dzfice
     156  REAL :: zmelt, zpluie, zice
     157  REAL :: zsolid
    195158!!!!
    196159!  Variables pour Bergeron
    197   REAL zcp, coef1, DeltaT, Deltaq, Deltaqprecl
    198   REAL zqpreci(klon), zqprecl(klon)
     160  REAL :: zcp, coef1, DeltaT, Deltaq, Deltaqprecl
     161  REAL, DIMENSION(klon) :: zqpreci, zqprecl
    199162! Variable pour conservation enegie des precipitations
    200   REAL zmqc(klon)
    201   !
    202   LOGICAL appel1er
    203   SAVE appel1er
     163  REAL, DIMENSION(klon) :: zmqc
     164  !
     165  LOGICAL, SAVE :: appel1er=.TRUE.
    204166  !$OMP THREADPRIVATE(appel1er)
    205167  !
    206168! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
    207169! iflag_oldbug_fisrtilp=1 ajoute le BUG
    208   INTEGER,SAVE :: iflag_oldbug_fisrtilp=0 !=0 sans bug
    209   !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp)
    210170  !---------------------------------------------------------------
    211171  !
    … …  
    214174  !AA  A priori on a 4 scavenging # possibles
    215175  !
    216   REAL a_tr_sca(4)
    217   save a_tr_sca
    218   !$OMP THREADPRIVATE(a_tr_sca)
    219   !
    220176  ! Variables intermediaires
    221177  !
    222   REAL zalpha_tr
    223   REAL zfrac_lessi
    224   REAL zprec_cond(klon)
     178  REAL :: zalpha_tr, zfrac_lessi
     179  REAL, DIMENSION(klon) :: zprec_cond
    225180  !AA
    226181! RomP >>> 15 nov 2012
    227   REAL   beta(klon,klev) ! taux de conversion de l'eau cond
     182  REAL, DIMENSION(klon,klev) :: beta ! taux de conversion de l'eau cond
    228183! RomP <<<
    229   REAL zmair(klon), zcpair, zcpeau
     184  REAL, DIMENSION(klon) :: zmair
     185  REAL :: zcpair, zcpeau
    230186  !     Pour la conversion eau-neige
    231   REAL zlh_solid(klon), zm_solid
     187  REAL, DIMENSION(klon) :: zlh_solid
     188  REAL :: zm_solid
    232189  !---------------------------------------------------------------
    233190  !
    234191  ! Fonctions en ligne:
    235192  !
    236   REAL fallvs,fallvc ! Vitesse de chute pour cristaux de glace
     193  REAL ::  fallvs,fallvc ! Vitesse de chute pour cristaux de glace
    237194                     ! (Heymsfield & Donner, 1990)
    238195  REAL zzz
    … …  
    242199  fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
    243200  !
    244   DATA appel1er /.TRUE./
    245201  !ym
    246202!CR: pour iflag_ice_thermo=2, on active que la convection
    … …  
    248204
    249205 
    250   itap=itap+1
    251206  znebprecip(:)=0.
    252207
    … …  
    264219  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
    265220  IF (appel1er) THEN
    266      CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
    267      CALL getin_p('iflag_evap_prec',iflag_evap_prec)
    268      CALL getin_p('seuil_neb',seuil_neb)
    269 !<LTP   
    270      CALL getin_p('rain_int_min',rain_int_min)
    271 !>LTP
    272      write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp
    273      !
    274221     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
    275      WRITE(lunout,*) 'fisrtilp, iflag_evap_prec:', iflag_evap_prec
    276 !<LTP   
    277      WRITE(lunout,*) 'fisrtilp, rain_int_min:', rain_int_min
    278 !>LTP   
    279222     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
    280223     WRITE(lunout,*) 'FISRTILP VERSION LUDO'
    … …  
    286229     ENDIF
    287230     appel1er = .FALSE.
    288      !
    289      !AA initialiation provisoire
    290      a_tr_sca(1) = -0.5
    291      a_tr_sca(2) = -0.5
    292      a_tr_sca(3) = -0.5
    293      a_tr_sca(4) = -0.5
    294      !
    295      !AA Initialisation a 1 des coefs des fractions lessivees
    296231     !
    297232     !cdir collapse
    … …  
    416351     !   - zmqc: masse de precip qui doit etre thermalisee
    417352     !
    418      IF(k.LE.klevm1) THEN         
     353     IF(k.LE.klev-1) THEN         
    419354        DO i = 1, klon
    420355           !IM
    … …  
    437372         end if
    438373        ENDDO
    439      ELSE  ! IF(k.LE.klevm1)
     374     ELSE  ! IF(k.LE.klev-1)
    440375        DO i = 1, klon
    441376           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
    442377           zmqc(i) = 0.
    443378        ENDDO
    444      ENDIF ! end IF(k.LE.klevm1)
     379     ENDIF ! end IF(k.LE.klev-1)
    445380     !
    446381     ! ----------------------------------------------------------------
    … …  
    698633!>LTP       
    699634
    700 
    701 !        print*,'REEVAP ',itap,k,znebprecip(1),zqev0,zqev,zqevi,zrfl(1)
    702635
    703636!CR ATTENTION: deplacement de la fonte de la glace
Note: See TracChangeset for help on using the changeset viewer.