Ignore:
Timestamp:
Mar 30, 2015, 11:08:45 AM (10 years ago)
Author:
jyg
Message:

1/ Introduction of two variables in the ".def" files: (i) cvl_sig2feed is
the top of the convective feeding layer in sigma coordinates (D=0.97);
(ii) cvl_comp_threshold is the threshold fraction of convective points
below which compression occurs (D=1.).
2/ Corrections of various bugs revealed by the changes in compression:

  • correct bugs in cv3a_uncompress.F90 for 3 fields used for convective

scavenging.

  • add a reset to zero of "sig" and "w0" for non-convective points

(cva_driver.F90).

  • in cv3_routines.F90, correct bounds of a few loops in cv3_undilute2,

correct the reset of the no-convection counter in cv3_yield.

  • in phys_output_write_mod.F90, correct output of wdtrainA and wdtrainM.

3/ Improve declarations in various subroutines.

Modified files:

conema3.h
cv3param.h
cv3p1_closure.F90
conf_phys_m.F90
cv3a_compress.F90
phys_output_write_mod.F90
cv3_routines.F90
concvl.F90
cva_driver.F90
cv3a_uncompress.F90

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/cva_driver.F90

    r2207 r2253  
    44SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, &
    55                      iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
    6                       delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
     6!!                      delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &  ! jyg
     7                      delt, comp_threshold, &                                      ! jyg
     8                      t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &          ! jyg
    79                      u1, v1, tra1, &
    810                      p1, ph1, &
    … …  
    1921                      ftd1, fqd1, &
    2022                      Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
    21                       lalim_conv, &
     23                      lalim_conv1, &
    2224!!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
    2325!!                      elij1,evap1,ep1,epmlmMm1,eplaMm1, &                ! RomP
    … …  
    6062! ok_conserv_q  Logical        Input        when true corrections for water conservation are swtiched on
    6163! delt          Real           Input        time step
     64! comp_threshold Real           Input       threshold on the fraction of convective points below which
     65!                                            fields  are compressed
    6266! t1            Real           Input        temperature (sat draught envt)
    6367! q1            Real           Input        specific hum (sat draught envt)
    … …  
    156160  include 'iniprint.h'
    157161
    158 
    159162! Input
    160   INTEGER len
    161   INTEGER nd
    162   INTEGER ndp1
    163   INTEGER ntra
    164   INTEGER iflag_con
    165   INTEGER iflag_mix
    166   INTEGER iflag_ice_thermo
    167   INTEGER iflag_clos
    168   LOGICAL ok_conserv_q
    169   REAL tau_cld_cv
    170   REAL coefw_cld_cv
    171   REAL delt
    172   REAL t1(len, nd)
    173   REAL q1(len, nd)
    174   REAL qs1(len, nd)
    175   REAL t1_wake(len, nd)
    176   REAL q1_wake(len, nd)
    177   REAL qs1_wake(len, nd)
    178   REAL s1_wake(len)
    179   REAL u1(len, nd)
    180   REAL v1(len, nd)
    181   REAL tra1(len, nd, ntra)
    182   REAL p1(len, nd)
    183   REAL ph1(len, ndp1)
    184   REAL Ale1(len)
    185   REAL Alp1(len)
    186   REAL omega1(len,nd)
    187   REAL sig1feed1 ! pressure at lower bound of feeding layer
    188   REAL sig2feed1 ! pressure at upper bound of feeding layer
    189   REAL wght1(nd) ! weight density determining the feeding mixture
     163  INTEGER, INTENT (IN)                               :: len
     164  INTEGER, INTENT (IN)                               :: nd
     165  INTEGER, INTENT (IN)                               :: ndp1
     166  INTEGER, INTENT (IN)                               :: ntra
     167  INTEGER, INTENT (IN)                               :: iflag_con
     168  INTEGER, INTENT (IN)                               :: iflag_mix
     169  INTEGER, INTENT (IN)                               :: iflag_ice_thermo
     170  INTEGER, INTENT (IN)                               :: iflag_clos
     171  LOGICAL, INTENT (IN)                               :: ok_conserv_q
     172  REAL, INTENT (IN)                                  :: tau_cld_cv
     173  REAL, INTENT (IN)                                  :: coefw_cld_cv
     174  REAL, INTENT (IN)                                  :: delt
     175  REAL, INTENT (IN)                                  :: comp_threshold
     176  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1
     177  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1
     178  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1
     179  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake
     180  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1_wake
     181  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1_wake
     182  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
     183  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1
     184  REAL, DIMENSION (len, nd), INTENT (IN)             :: v1
     185  REAL, DIMENSION (len, nd, ntra), INTENT (IN)       :: tra1
     186  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
     187  REAL, DIMENSION (len, ndp1), INTENT (IN)           :: ph1
     188  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1
     189  REAL, DIMENSION (len), INTENT (IN)                 :: Alp1
     190  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
     191  REAL, INTENT (IN)                                  :: sig1feed1 ! pressure at lower bound of feeding layer
     192  REAL, INTENT (IN)                                  :: sig2feed1 ! pressure at upper bound of feeding layer
     193  REAL, DIMENSION (nd), INTENT (IN)                  :: wght1     ! weight density determining the feeding mixture
     194  INTEGER, DIMENSION (len), INTENT (IN)              :: lalim_conv1
     195
     196! Input/Output
     197  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: sig1
     198  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: w01
    190199
    191200! Output
    192   INTEGER iflag1(len)
    193   REAL ft1(len, nd)
    194   REAL fq1(len, nd)
    195   REAL fu1(len, nd)
    196   REAL fv1(len, nd)
    197   REAL ftra1(len, nd, ntra)
    198   REAL precip1(len)
    199   INTEGER kbas1(len)
    200   INTEGER ktop1(len)
    201   REAL cbmf1(len)
    202   REAL plcl1(klon)
    203   REAL plfc1(klon)
    204   REAL wbeff1(klon)
    205   REAL sig1(len, klev) !input/output
    206   REAL w01(len, klev) !input/output
    207   REAL ptop21(len)
    208   REAL sigd1(len)
    209   REAL ma1(len, nd)
    210   REAL mip1(len, nd)
     201  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1
     202  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1
     203  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fq1
     204  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fu1
     205  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fv1
     206  REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
     207  REAL, DIMENSION (len), INTENT (OUT)                :: precip1
     208  INTEGER, DIMENSION (len), INTENT (OUT)             :: kbas1
     209  INTEGER, DIMENSION (len), INTENT (OUT)             :: ktop1
     210  REAL, DIMENSION (len), INTENT (OUT)                :: cbmf1
     211  REAL, DIMENSION (len), INTENT (OUT)                :: plcl1
     212  REAL, DIMENSION (len), INTENT (OUT)                :: plfc1
     213  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
     214  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
     215  REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
     216  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1
     217  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mip1
    211218! real Vprecip1(len,nd)
    212   REAL vprecip1(len, nd+1)
    213   REAL upwd1(len, nd)
    214   REAL dnwd1(len, nd)
    215   REAL dnwd01(len, nd)
    216   REAL qcondc1(len, nd) ! cld
    217   REAL wd1(len) ! gust
    218   REAL cape1(len)
    219   REAL cin1(len)
    220   REAL tvp1(len, nd)
     219  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecip1
     220  REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1
     221  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd1
     222  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd01
     223  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1        ! cld
     224  REAL, DIMENSION (len), INTENT (OUT)                :: wd1            ! gust
     225  REAL, DIMENSION (len), INTENT (OUT)                :: cape1
     226  REAL, DIMENSION (len), INTENT (OUT)                :: cin1
     227  REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1
    221228
    222229!AC!
    … …  
    224231!!      real da(len,nd),phi(len,nd,nd)
    225232!AC!
    226   REAL ftd1(len, nd)
    227   REAL fqd1(len, nd)
    228   REAL Plim11(len)
    229   REAL Plim21(len)
    230   REAL asupmax1(len, nd)
    231   REAL supmax01(len)
    232   REAL asupmaxmin1(len)
    233   INTEGER lalim_conv(len)
    234   REAL qtc1(len, nd)         ! cld
    235   REAL sigt1(len, nd)        ! cld
     233  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1
     234  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqd1
     235  REAL, DIMENSION (len), INTENT (OUT)                :: Plim11
     236  REAL, DIMENSION (len), INTENT (OUT)                :: Plim21
     237  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1
     238  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01
     239  REAL, DIMENSION (len), INTENT (OUT)                :: asupmaxmin1
     240  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1            ! cld
     241  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1           ! cld
    236242
    237243! RomP >>>
    238   REAL wdtrainA1(len, nd), wdtrainM1(len, nd)
    239   REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
    240   REAL epmlmMm1(len, nd, nd), eplaMm1(len, nd)
    241   REAL evap1(len, nd), ep1(len, nd)
    242   REAL sigij1(len, nd, nd), elij1(len, nd, nd)
     244  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainM1
     245  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1, mp1
     246  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1
     247  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1
     248  REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplaMm1
     249  REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1, ep1
     250  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1, elij1
    243251!JYG,RL
    244   REAL wghti1(len, nd) ! final weight of the feeding layers
     252  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti1      ! final weight of the feeding layers
    245253!JYG,RL
    246   REAL phi21(len, nd, nd)
    247   REAL d1a1(len, nd), dam1(len, nd)
     254  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21
     255  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1, dam1
    248256! RomP <<<
    249257
    … …  
    388396!$OMP THREADPRIVATE(debut)
    389397
     398  REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
    390399  REAL tnk1(klon)
    391400  REAL thnk1(klon)
    … …  
    430439
    431440  INTEGER idcum(nloc)
     441!jyg<
     442  LOGICAL compress    ! True if compression occurs
     443!>jyg
    432444  INTEGER iflag(nloc), nk(nloc), icb(nloc)
    433445  INTEGER nent(nloc, klev)
    … …  
    682694!   p2feed1(i)=ph1(i,3)
    683695!testCR: on prend la couche alim des thermiques
    684 !   p2feed1(i)=ph1(i,lalim_conv(i)+1)
     696!   p2feed1(i)=ph1(i,lalim_conv1(i)+1)
    685697!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
    686698  END DO
    … …  
    762774! =====================================================================
    763775
     776!  Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
     777!  gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
     778!  elsewhere).
    764779  ncum = 0
     780  coef_convective(:) = 0.
    765781  DO i = 1, len
    766782    IF (iflag1(i)==0) THEN
     783      coef_convective(i) = 1.
    767784      ncum = ncum + 1
    768785      idcum(ncum) = i
    … …  
    782799! print*,'ncum tv1 ',ncum,tv1
    783800! print*,'tvp1 ',tvp1
    784       CALL cv3a_compress(len, nloc, ncum, nd, ntra, &
     801!jyg<
     802!   If the fraction of convective points is larger than comp_threshold, then compression
     803!   is assumed useless.
     804!
     805  compress = ncum .lt. len*comp_threshold
     806!
     807  IF (.not. compress) THEN
     808    DO i = 1,len
     809      idcum(i) = i
     810    ENDDO
     811  ENDIF
     812!
     813  print *,' ncum, len, comp_threshold, compress ',ncum, len, comp_threshold, compress
     814!>jyg
     815      CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
    785816                         iflag1, nk1, icb1, icbs1, &
    786817                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
    … …  
    837868                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
    838869                         frac)
    839 
    840870    END IF
    841871
    … …  
    897927                           Plim1, plim2, asupmax, supmax0, &
    898928                           asupmaxmin, cbmf, plfc, wbeff)
    899 
    900929        if (prt_level >= 10) &
    901930             PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
    … …  
    10351064
    10361065    IF (iflag_con==3) THEN
    1037       CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, &
     1066      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
    10381067                           iflag, icb, inb, &
    10391068                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
    … …  
    10781107  END IF ! ncum>0
    10791108
     1109!
     1110! In order take into account the possibility of changing the compression,
     1111! reset m, sig and w0 to zero for non-convective points.
     1112  DO k = 1,nd-1
     1113        sig1(:, k) = sig1(:, k)*coef_convective(:)
     1114        w01(:, k)  = w01(:, k)*coef_convective(:)
     1115  ENDDO
     1116
    10801117  IF (debut) THEN
    10811118    PRINT *, ' cv_compress -> '
Note: See TracChangeset for help on using the changeset viewer.