Changeset 2393


Ignore:
Timestamp:
Nov 18, 2015, 12:25:20 PM (9 years ago)
Author:
jyg
Message:

Add various intializations of arrays in lmdz1d.F90
and in the convection scheme. Add output variables
for boundary layer splitting.

Location:
LMDZ5/trunk/libf/phylmd
Files:
7 edited

Legend:

Unmodified
Added
Removed

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

    r2376 r2393  
    4141
    4242
     43! Local variables
    4344  CHARACTER (LEN=20) :: modname = 'cv3_param'
    4445  CHARACTER (LEN=80) :: abort_message
    … …  
    384385    IF (ok_new_feed) THEN
    385386      IF (iter==niter) THEN
    386         DO k = minorig, nd
     387        DO k = minorig, nl
    387388          DO i = 1, len
    388389            IF (ph(i,k)>=plclfeed(i)) pfeedmin(i) = ph(i, k)
    … …  
    15151516! =====================================================================
    15161517
    1517   DO k = 1, nd
     1518  DO k = 1, nl
    15181519    DO i = 1, ncum
    15191520      hp(i, k) = h(i, k)
    … …  
    21892190! MAF: renormalisation de MENT
    21902191  CALL zilch(zm, nloc*na)
    2191   DO jm = 1, nd
    2192     DO im = 1, nd
     2192  DO jm = 1, nl
     2193    DO im = 1, nl
    21932194      DO il = 1, ncum
    21942195        zm(il, im) = zm(il, im) + (1.-sij(il,im,jm))*ment(il, im, jm)
    … …  
    21972198  END DO
    21982199
    2199   DO jm = 1, nd
    2200     DO im = 1, nd
     2200  DO jm = 1, nl
     2201    DO im = 1, nl
    22012202      DO il = 1, ncum
    22022203        IF (zm(il,im)/=0.) THEN
    … …  
    22072208  END DO
    22082209
    2209   DO jm = 1, nd
    2210     DO im = 1, nd
     2210  DO jm = 1, nl
     2211    DO im = 1, nl
    22112212      DO il = 1, ncum
    22122213        qents(il, im, jm) = qent(il, im, jm)
    … …  
    22262227                     faci, b, sigd, &
    22272228                     wdtrainA, wdtrainM)                                      ! RomP
     2229  USE print_control_mod, ONLY: prt_level, lunout
    22282230  IMPLICIT NONE
    22292231
    … …  
    22352237
    22362238!inputs:
    2237   INTEGER ncum, nd, na, ntra, nloc
    2238   INTEGER icb(nloc), inb(nloc)
    2239   REAL delt, plcl(nloc)
    2240   REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd), gz(nloc, na)
    2241   REAL u(nloc, nd), v(nloc, nd)
     2239  INTEGER, INTENT (IN)                               :: ncum, nd, na, ntra, nloc
     2240  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb
     2241  REAL, INTENT(IN)                                   :: delt
     2242  REAL, DIMENSION (nloc), INTENT (IN)                :: plcl
     2243  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, rr, rs
     2244  REAL, DIMENSION (nloc, na), INTENT (IN)            :: gz
     2245  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: u, v
    22422246  REAL tra(nloc, nd, ntra)
    22432247  REAL p(nloc, nd), ph(nloc, nd+1)
    2244   REAL ep(nloc, na), sigp(nloc, na), clw(nloc, na)
    2245   REAL th(nloc, na), tv(nloc, na), lv(nloc, na), cpn(nloc, na)
    2246   REAL lf(nloc, na)
    2247   REAL m(nloc, na), ment(nloc, na, na), elij(nloc, na, na)
    2248   REAL coef_clos(nloc)
     2248  REAL, DIMENSION (nloc, na), INTENT (IN)            :: ep, sigp, clw
     2249  REAL, DIMENSION (nloc, na), INTENT (IN)            :: th, tv, lv, cpn
     2250  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lf
     2251  REAL, DIMENSION (nloc, na), INTENT (IN)            :: m
     2252  REAL, DIMENSION (nloc, na, na), INTENT (IN)        :: ment, elij
     2253  REAL, DIMENSION (nloc), INTENT (IN)                :: coef_clos
    22492254
    22502255!input/output
    2251   INTEGER iflag(nloc)
     2256  INTEGER, DIMENSION (nloc), INTENT (INOUT)          :: iflag(nloc)
    22522257
    22532258!outputs:
    2254   REAL mp(nloc, na), rp(nloc, na), up(nloc, na), vp(nloc, na)
    2255   REAL water(nloc, na), evap(nloc, na), wt(nloc, na)
    2256   REAL ice(nloc, na), fondue(nloc, na), faci(nloc, na)
    2257   REAL trap(nloc, na, ntra)
    2258   REAL b(nloc, na), sigd(nloc)
     2259  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: mp, rp, up, vp
     2260  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: water, evap, wt
     2261  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: ice, fondue, faci
     2262  REAL, DIMENSION (nloc, na, ntra), INTENT (OUT)     :: trap
     2263  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: b
     2264  REAL, DIMENSION (nloc), INTENT (OUT)               :: sigd
    22592265! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
    22602266! de l ascendance adiabatique et des flux melanges Pa et Pm.
    22612267! Distinction des wdtrain
    22622268! Pa = wdtrainA     Pm = wdtrainM
    2263   REAL wdtrainA(nloc, na), wdtrainM(nloc, na)
     2269  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: wdtrainA, wdtrainM
    22642270
    22652271!local variables
    … …  
    22812287! ------------------------------------------------------
    22822288
    2283   delti = 1./delt
    2284   tinv = 1./3.
    2285 
    2286   mp(:, :) = 0.
    2287 
    2288   DO i = 1, nl
     2289! =============================
     2290! --- INITIALIZE OUTPUT ARRAYS
     2291! =============================
     2292!  (loops up to nl+1)
     2293
     2294  DO i = 1, nlp
    22892295    DO il = 1, ncum
    22902296      mp(il, i) = 0.0
    … …  
    22942300      wt(il, i) = 0.001
    22952301      water(il, i) = 0.0
    2296       frac(il, i) = 0.0
    22972302      faci(il, i) = 0.0
    2298       fraci(il, i) = 0.0
    22992303      ice(il, i) = 0.0
    2300       prec(il, i) = 0.0
    23012304      fondue(il, i) = 0.0
    23022305      evap(il, i) = 0.0
    23032306      b(il, i) = 0.0
     2307    END DO
     2308  END DO
     2309!! RomP >>>
     2310  DO i = 1, nlp
     2311    DO il = 1, ncum
     2312      wdtrainA(il, i) = 0.0
     2313      wdtrainM(il, i) = 0.0
     2314    END DO
     2315  END DO
     2316!! RomP <<<
     2317
     2318! ***  Set the fractionnal area sigd of precipitating downdraughts
     2319  DO il = 1, ncum
     2320    sigd(il) = sigdz*coef_clos(il)
     2321  END DO
     2322
     2323! =====================================================================
     2324! --- INITIALIZE VARIOUS ARRAYS AND PARAMETERS USED IN THE COMPUTATIONS
     2325! =====================================================================
     2326!  (loops up to nl+1)
     2327
     2328  delti = 1./delt
     2329  tinv = 1./3.
     2330
     2331  DO i = 1, nlp
     2332    DO il = 1, ncum
     2333      frac(il, i) = 0.0
     2334      fraci(il, i) = 0.0
     2335      prec(il, i) = 0.0
    23042336      lvcp(il, i) = lv(il, i)/cpn(il, i)
    23052337      lfcp(il, i) = lf(il, i)/cpn(il, i)
    23062338    END DO
    23072339  END DO
     2340
    23082341!AC!        do k=1,ntra
    23092342!AC!         do i=1,nd
    … …  
    23132346!AC!         enddo
    23142347!AC!        enddo
    2315 !! RomP >>>
    2316   DO i = 1, nd
    2317     DO il = 1, ncum
    2318       wdtrainA(il, i) = 0.0
    2319       wdtrainM(il, i) = 0.0
    2320     END DO
    2321   END DO
    2322 !! RomP <<<
    23232348
    23242349! ***  check whether ep(inb)=0, if so, skip precipitating    ***
    … …  
    23302355!!          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
    23312356    lwork(il) = ep(il, inb(il)) >= 0.0001
    2332   END DO
    2333 
    2334 ! ***  Set the fractionnal area sigd of precipitating downdraughts
    2335   DO il = 1, ncum
    2336     sigd(il) = sigdz*coef_clos(il)
    23372357  END DO
    23382358
    … …  
    24482468        bfac = 1./(sigd(il)*wt(il,i))
    24492469
     2470!
     2471    IF (prt_level >= 20) THEN
     2472      Print*, 'cv3_unsat after provisional rp estimate: rp, afac, bfac ', &
     2473          i, rp(1, i), afac,bfac
     2474    ENDIF
     2475!
    24502476!JYG1
    24512477! cc        sigt=1.0
    … …  
    25222548          evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(prec(il,i+1)-prec(il,i))) / &
    25232549                        (sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
     2550!
     2551    IF (prt_level >= 20) THEN
     2552      Print*, 'cv3_unsat after evap computation: wdtrain, sigd, wt, prec(i+1),prec(i) ', &
     2553          i, wdtrain(1), sigd(1), wt(1,i), prec(1,i+1),prec(1,i)
     2554    ENDIF
     2555!
    25242556
    25252557          d6 = bfac*wdtrain(il) - 100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
    … …  
    27212753    END DO
    27222754! ----------------------------------------------------------------
     2755!
     2756    IF (prt_level >= 20) THEN
     2757      Print*, 'cv3_unsat after mp computation: mp, b(i), b(i-1) ', &
     2758          i, mp(1, i), b(1,i), b(1,max(i-1,1))
     2759    ENDIF
     2760!
    27232761
    27242762! ***       find mixing ratio of precipitating downdraft     ***
    … …  
    29042942  delti = 1.0/delt
    29052943! print*,'cv3_yield initialisation delt', delt
    2906 !
     2944
    29072945  DO il = 1, ncum
    29082946    precip(il) = 0.0
    2909     Vprecip(il, nd+1) = 0.0
    2910     Vprecipi(il, nd+1) = 0.0                              ! jyg: Vprecipi
    29112947    wd(il) = 0.0 ! gust
    29122948  END DO
    29132949
    2914   DO i = 1, nd
     2950!   Fluxes are on a staggered grid : loops extend up to nl+1
     2951  DO i = 1, nlp
    29152952    DO il = 1, ncum
    29162953      Vprecip(il, i) = 0.0
    29172954      Vprecipi(il, i) = 0.0                               ! jyg
     2955      upwd(il, i) = 0.0
     2956      dnwd(il, i) = 0.0
     2957      dnwd0(il, i) = 0.0
     2958      mip(il, i) = 0.0
     2959    END DO
     2960  END DO
     2961  DO i = 1, nl
     2962    DO il = 1, ncum
    29182963      ft(il, i) = 0.0
    29192964      fr(il, i) = 0.0
    29202965      fu(il, i) = 0.0
    29212966      fv(il, i) = 0.0
    2922       upwd(il, i) = 0.0
    2923       dnwd(il, i) = 0.0
    2924       dnwd0(il, i) = 0.0
    2925       mip(il, i) = 0.0
    29262967      ftd(il, i) = 0.0
    29272968      fqd(il, i) = 0.0
    … …  
    31473188    IF (num1<=0) GO TO 500
    31483189
    3149     CALL zilch(amp1, ncum)
    3150     CALL zilch(ad, ncum)
     3190!jyg<
     3191!!    CALL zilch(amp1, ncum)
     3192!!    CALL zilch(ad, ncum)
     3193    DO il = 1,ncum
     3194      amp1(il) = 0.
     3195      ad(il) = 0.
     3196    ENDDO
     3197!>jyg
    31513198
    31523199    DO k = 1, nl + 1
    … …  
    36673714
    36683715
    3669   DO i = 1, nd
     3716  DO i = 1, nl
    36703717    DO il = 1, ncum
    36713718      upwd(il, i) = 0.0
    … …  
    36793726    END DO
    36803727  END DO
    3681   DO i = nl + 1, nd
    3682     DO il = 1, ncum
    3683       dnwd0(il, i) = 0.
    3684     END DO
    3685   END DO
     3728!jyg<  (loops stop at nl)
     3729!!  DO i = nl + 1, nd
     3730!!    DO il = 1, ncum
     3731!!      dnwd0(il, i) = 0.
     3732!!    END DO
     3733!!  END DO
     3734!>jyg
    36863735
    36873736
    … …  
    37783827  END DO
    37793828
    3780   DO i = nl + 1, nd
    3781     DO il = 1, ncum
    3782       mip(il, i) = 0.
    3783     END DO
    3784   END DO
    3785 
    3786   DO i = 1, nd
     3829!jyg<  (loops stop at nl)
     3830!!  DO i = nl + 1, nd
     3831!!    DO il = 1, ncum
     3832!!      mip(il, i) = 0.
     3833!!    END DO
     3834!!  END DO
     3835!>jyg
     3836
     3837  DO i = 1, nlp
    37873838    DO il = 1, ncum
    37883839      ma(il, i) = 0
    … …  
    37983849  END DO
    37993850
    3800   DO i = nl + 1, nd
    3801     DO il = 1, ncum
    3802       ma(il, i) = 0.
    3803     END DO
    3804   END DO
     3851!jyg<  (loops stop at nl)
     3852!!  DO i = nl + 1, nd
     3853!!    DO il = 1, ncum
     3854!!      ma(il, i) = 0.
     3855!!    END DO
     3856!!  END DO
     3857!>jyg
    38053858
    38063859  DO i = 1, nl
    … …  
    38363889!! cld                                                               
    38373890                                                                     
    3838   DO i = 1, nd                                                       ! cld
     3891  DO i = 1, nl+1                                                     ! cld
    38393892    DO il = 1, ncum                                                  ! cld
    38403893      mac(il, i) = 0.0                                               ! cld
    … …  
    39784031! fraction deau condensee dans les melanges convertie en precip : epm
    39794032! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
    3980   DO j = 1, na
    3981     DO k = 1, na
     4033  DO j = 1, nl
     4034    DO k = 1, nl
    39824035      DO i = 1, ncum
    39834036        IF (k>=icb(i) .AND. k<=inb(i) .AND. &
    … …  
    39944047
    39954048
    3996   DO j = 1, na
    3997     DO k = 1, na
     4049  DO j = 1, nl
     4050    DO k = 1, nl
    39984051      DO i = 1, ncum
    39994052        IF (k>=icb(i) .AND. k<=inb(i)) THEN
    … …  
    40054058  END DO
    40064059
    4007   DO j = 1, na
     4060  DO j = 1, nl
    40084061    DO k = 1, j - 1
    40094062      DO i = 1, ncum
    … …  
    40164069
    40174070! matrices pour calculer la tendance des concentrations dans cvltr.F90
    4018   DO j = 1, na
    4019     DO k = 1, na
     4071  DO j = 1, nl
     4072    DO k = 1, nl
    40204073      DO i = 1, ncum
    40214074        da(i, j) = da(i, j) + (1.-sigij(i,k,j))*ment(i, k, j)

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

    r2306 r2393  
    146146    END DO
    147147   
    148     DO k = 1, nl+1
     148    DO k = 1, nl
    149149      DO i = 1, ncum
    150150        sig1(idcum(i), k) = sig(i, k)
    … …  
    182182      END DO
    183183    END DO
     184
     185! Fluxes are defined on a staggered grid and extend up to nl+1
     186    DO i = 1, ncum
     187      ma1(idcum(i), nlp) = 0.
     188      vprecip1(idcum(i), nlp) = 0.
     189      vprecipi1(idcum(i), nlp) = 0.
     190      upwd1(idcum(i), nlp) = 0.
     191      dnwd1(idcum(i), nlp) = 0.
     192      dnwd01(idcum(i), nlp) = 0.
     193    END DO
    184194   
    185195    ! AC!        do 2100 j=1,ntra
    … …  
    206216!!      END DO
    207217!!    END DO
    208       DO i = 1, ncum
    209         jdcum=idcum(i)
    210         phi1    (jdcum, 1:nl+1, 1:nl+1) = phi    (i, 1:nl+1, 1:nl+1)          !AC!
    211         phi21   (jdcum, 1:nl+1, 1:nl+1) = phi2   (i, 1:nl+1, 1:nl+1)          !RomP
    212         sigij1  (jdcum, 1:nl+1, 1:nl+1) = sigij  (i, 1:nl+1, 1:nl+1)          !RomP
    213         elij1   (jdcum, 1:nl+1, 1:nl+1) = elij   (i, 1:nl+1, 1:nl+1)          !RomP
    214         epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1)          !RomP+jyg
     218
     219!!      DO i = 1, ncum
     220!!        jdcum=idcum(i)
     221!!        phi1    (jdcum, 1:nl+1, 1:nl+1) = phi    (i, 1:nl+1, 1:nl+1)          !AC!
     222!!        phi21   (jdcum, 1:nl+1, 1:nl+1) = phi2   (i, 1:nl+1, 1:nl+1)          !RomP
     223!!        sigij1  (jdcum, 1:nl+1, 1:nl+1) = sigij  (i, 1:nl+1, 1:nl+1)          !RomP
     224!!        elij1   (jdcum, 1:nl+1, 1:nl+1) = elij   (i, 1:nl+1, 1:nl+1)          !RomP
     225!!        epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1)          !RomP+jyg
     226!!      END DO
     227!  These tracer associated arrays are defined up to nl, not nl+1
     228  DO i = 1, ncum
     229    jdcum=idcum(i)
     230    DO k = 1,nl
     231      DO j = 1,nl
     232        phi1    (jdcum, j, k) = phi    (i, j, k)          !AC!
     233        phi21   (jdcum, j, k) = phi2   (i, j, k)          !RomP
     234        sigij1  (jdcum, j, k) = sigij  (i, j, k)          !RomP
     235        elij1   (jdcum, j, k) = elij   (i, j, k)          !RomP
     236        epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k)          !RomP+jyg
    215237      END DO
     238    ENDDO
     239  ENDDO
    216240!>jyg
    217241    ! AC!
    … …  
    249273      asupmaxmin1(:) = asupmaxmin(:)
    250274!
    251       sig1(:, 1:nl+1) = sig(:, 1:nl+1)
    252       w01(:, 1:nl+1) = w0(:, 1:nl+1)
    253       ft1(:, 1:nl+1) = ft(:, 1:nl+1)
    254       fq1(:, 1:nl+1) = fq(:, 1:nl+1)
    255       fu1(:, 1:nl+1) = fu(:, 1:nl+1)
    256       fv1(:, 1:nl+1) = fv(:, 1:nl+1)
    257       ma1(:, 1:nl+1) = ma(:, 1:nl+1)
    258       mip1(:, 1:nl+1) = mip(:, 1:nl+1)
    259       vprecip1(:, 1:nl+1) = vprecip(:, 1:nl+1)
    260       vprecipi1(:, 1:nl+1) = vprecipi(:, 1:nl+1)
    261       upwd1(:, 1:nl+1) = upwd(:, 1:nl+1)
    262       dnwd1(:, 1:nl+1) = dnwd(:, 1:nl+1)
    263       dnwd01(:, 1:nl+1) = dnwd0(:, 1:nl+1)
    264       qcondc1(:, 1:nl+1) = qcondc(:, 1:nl+1)
    265       tvp1(:, 1:nl+1) = tvp(:, 1:nl+1)
    266       ftd1(:, 1:nl+1) = ftd(:, 1:nl+1)
    267       fqd1(:, 1:nl+1) = fqd(:, 1:nl+1)
    268       asupmax1(:, 1:nl+1) = asupmax(:, 1:nl+1)
    269 
    270       da1(:, 1:nl+1) = da(:, 1:nl+1)              !AC!
    271       mp1(:, 1:nl+1) = mp(:, 1:nl+1)              !RomP
    272       d1a1(:, 1:nl+1) = d1a(:, 1:nl+1)            !RomP
    273       dam1(:, 1:nl+1) = dam(:, 1:nl+1)            !RomP
    274       clw1(:, 1:nl+1) = clw(:, 1:nl+1)            !RomP
    275       evap1(:, 1:nl+1) = evap(:, 1:nl+1)          !RomP
    276       ep1(:, 1:nl+1) = ep(:, 1:nl+1)              !RomP
    277       eplamM1(:, 1:nl+1) = eplamM(:, 1:nl+1)       !RomP+jyg
    278       wdtrainA1(:, 1:nl+1) = wdtrainA(:, 1:nl+1)  !RomP
    279       wdtrainM1(:, 1:nl+1) = wdtrainM(:, 1:nl+1)  !RomP
    280       qtc1(:, 1:nl+1) = qtc(:, 1:nl+1)
    281       sigt1(:, 1:nl+1) = sigt(:, 1:nl+1)
    282 !
    283       phi1    (:, 1:nl+1, 1:nl+1) = phi    (:, 1:nl+1, 1:nl+1)  !AC!
    284       phi21   (:, 1:nl+1, 1:nl+1) = phi2   (:, 1:nl+1, 1:nl+1)  !RomP
    285       sigij1  (:, 1:nl+1, 1:nl+1) = sigij  (:, 1:nl+1, 1:nl+1)  !RomP
    286       elij1   (:, 1:nl+1, 1:nl+1) = elij   (:, 1:nl+1, 1:nl+1)  !RomP
    287       epmlmMm1(:, 1:nl+1, 1:nl+1) = epmlmMm(:, 1:nl+1, 1:nl+1)  !RomP+jyg
     275      sig1(:, 1:nl) = sig(:, 1:nl)
     276      w01(:, 1:nl) = w0(:, 1:nl)
     277      ft1(:, 1:nl) = ft(:, 1:nl)
     278      fq1(:, 1:nl) = fq(:, 1:nl)
     279      fu1(:, 1:nl) = fu(:, 1:nl)
     280      fv1(:, 1:nl) = fv(:, 1:nl)
     281      ma1(:, 1:nl) = ma(:, 1:nl)
     282      mip1(:, 1:nl) = mip(:, 1:nl)
     283      vprecip1(:, 1:nl) = vprecip(:, 1:nl)
     284      vprecipi1(:, 1:nl) = vprecipi(:, 1:nl)
     285      upwd1(:, 1:nl) = upwd(:, 1:nl)
     286      dnwd1(:, 1:nl) = dnwd(:, 1:nl)
     287      dnwd01(:, 1:nl) = dnwd0(:, 1:nl)
     288      qcondc1(:, 1:nl) = qcondc(:, 1:nl)
     289      tvp1(:, 1:nl) = tvp(:, 1:nl)
     290      ftd1(:, 1:nl) = ftd(:, 1:nl)
     291      fqd1(:, 1:nl) = fqd(:, 1:nl)
     292      asupmax1(:, 1:nl) = asupmax(:, 1:nl)
     293
     294      da1(:, 1:nl) = da(:, 1:nl)              !AC!
     295      mp1(:, 1:nl) = mp(:, 1:nl)              !RomP
     296      d1a1(:, 1:nl) = d1a(:, 1:nl)            !RomP
     297      dam1(:, 1:nl) = dam(:, 1:nl)            !RomP
     298      clw1(:, 1:nl) = clw(:, 1:nl)            !RomP
     299      evap1(:, 1:nl) = evap(:, 1:nl)          !RomP
     300      ep1(:, 1:nl) = ep(:, 1:nl)              !RomP
     301      eplamM1(:, 1:nl) = eplamM(:, 1:nl)       !RomP+jyg
     302      wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl)  !RomP
     303      wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl)  !RomP
     304      qtc1(:, 1:nl) = qtc(:, 1:nl)
     305      sigt1(:, 1:nl) = sigt(:, 1:nl)
     306!
     307      ma1(:, nlp) = 0.
     308      vprecip1(:, nlp) = 0.
     309      vprecipi1(:, nlp) = 0.
     310      upwd1(:, nlp) = 0.
     311      dnwd1(:, nlp) = 0.
     312      dnwd01(:, nlp) = 0.
     313
     314!
     315      phi1    (:, 1:nl, 1:nl) = phi    (:, 1:nl, 1:nl)  !AC!
     316      phi21   (:, 1:nl, 1:nl) = phi2   (:, 1:nl, 1:nl)  !RomP
     317      sigij1  (:, 1:nl, 1:nl) = sigij  (:, 1:nl, 1:nl)  !RomP
     318      elij1   (:, 1:nl, 1:nl) = elij   (:, 1:nl, 1:nl)  !RomP
     319      epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl)  !RomP+jyg
    288320  ENDIF !(compress)
    289321!>jyg

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

    r2226 r2393  
    1313! **************************************************************
    1414
     15  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
     16
    1517  IMPLICIT NONE
    1618
    … …  
    3032  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: tra ! input of convect3
    3133  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lv
    32   REAL, DIMENSION (nloc, na), INTENT (IN)            :: h  !liquid water static energy of environMent
     34  REAL, DIMENSION (nloc, na), INTENT (IN)            :: h  !liquid water static energy of environment
    3335  REAL, DIMENSION (nloc, na), INTENT (IN)            :: hp !liquid water static energy of air shed from adiab. asc.
    3436  REAL, DIMENSION (nloc, na), INTENT (IN)            :: tv, tvp
    … …  
    3941  REAL, DIMENSION (nloc, na, na), INTENT (OUT)       :: uent, vent
    4042  REAL, DIMENSION (nloc, na, na), INTENT (OUT)       :: Sigij, elij
    41   REAL, DIMENSION (nloc, na), INTENT (OUT)           :: supmax(nloc, na) ! Highest mixing fraction of mixed
     43  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: supmax          ! Highest mixing fraction of mixed
    4244                                                                         ! updraughts with the sign of (h-hp)
    4345  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent
    … …  
    6870  INTEGER nstep
    6971
     72  INTEGER,SAVE                                       :: igout=1
     73!$OMP THREADPRIVATE(igout)
     74
    7075! --   Mixing probability distribution functions
    7176
    … …  
    97102    Qcoef1max = Qcoef1(Fmax)
    98103    Qcoef2max = Qcoef2(Fmax)
     104!<jyg
     105   print*, 'fmax, gammas, qqa1, qqa2, Qcoef1max, Qcoef2max ', &
     106            fmax, gammas, qqa1, qqa2, Qcoef1max, Qcoef2max
     107!>jyg
    99108
    100109  END IF
    … …  
    131140!AC!
    132141
    133   DO k = 1, ntra
    134     DO j = 1, nd ! instead nlp
    135       DO i = 1, nd ! instead nlp
    136         DO il = 1, ncum
    137           traent(il, i, j, k) = tra(il, j, k)
    138         END DO
    139       END DO
    140     END DO
    141   END DO
     142!jyg!  DO k = 1, ntra
     143!jyg!    DO j = 1, nd ! instead nlp
     144!jyg!      DO i = 1, nd ! instead nlp
     145!jyg!        DO il = 1, ncum
     146!jyg!          traent(il, i, j, k) = tra(il, j, k)
     147!jyg!        END DO
     148!jyg!      END DO
     149!jyg!    END DO
     150!jyg!  END DO
    142151
    143152! =====================================================================
    … …  
    188197    END DO
    189198
     199!jygdebug<
     200    IF (prt_level >= 10) THEN
     201      print *,'cv3p_mixing i, nent(i), icb, inb ',i, nent(igout,i), icb(igout), inb(igout)
     202      IF (nent(igout,i) .gt. 0) THEN
     203        print *,'i,(j,Sij(i,j),j=icb-1,inb) ',i,(j,Sij(igout,i,j),j=icb(igout)-1,inb(igout))
     204      ENDIF
     205    ENDIF
     206!>jygdebug
    190207
    191208! ***   if no air can entrain at level i assume that updraft detrains  ***
    … …  
    209226  END DO
    210227
    211   DO j = 1, ntra
    212     DO i = minorig + 1, nl
    213       DO il = 1, ncum
    214         IF (i>=icb(il) .AND. i<=inb(il) .AND. nent(il,i)==0) THEN
    215           traent(il, i, i, j) = tra(il, nk(il), j)
    216         END IF
    217       END DO
    218     END DO
    219   END DO
     228!jyg!  DO j = 1, ntra
     229!jyg!    DO i = minorig + 1, nl
     230!jyg!      DO il = 1, ncum
     231!jyg!        IF (i>=icb(il) .AND. i<=inb(il) .AND. nent(il,i)==0) THEN
     232!jyg!          traent(il, i, i, j) = tra(il, nk(il), j)
     233!jyg!        END IF
     234!jyg!      END DO
     235!jyg!    END DO
     236!jyg!  END DO
    220237
    221238  DO j = minorig, nl
    … …  
    470487        END IF
    471488      END DO
    472       DO k = 1, ntra
    473         DO il = 1, ncum
    474           IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
    475               (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
    476               lwork(il)) THEN
    477             IF (Sij(il,i,j)>0.0) THEN
    478               traent(il, i, j, k) = Sigij(il, i, j)*tra(il, i, k) + &
    479                                     (1.-Sigij(il,i,j))*tra(il, nk(il), k)
    480             END IF
    481           END IF
    482         END DO
    483       END DO
     489!jyg!      DO k = 1, ntra
     490!jyg!        DO il = 1, ncum
     491!jyg!          IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
     492!jyg!              (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
     493!jyg!              lwork(il)) THEN
     494!jyg!            IF (Sij(il,i,j)>0.0) THEN
     495!jyg!              traent(il, i, j, k) = Sigij(il, i, j)*tra(il, i, k) + &
     496!jyg!                                    (1.-Sigij(il,i,j))*tra(il, nk(il), k)
     497!jyg!            END IF
     498!jyg!          END IF
     499!jyg!        END DO
     500!jyg!      END DO
    484501
    485502! --    If I=J (detrainement and entrainement at the same level), then only the
    … …  
    504521          END IF
    505522        END DO
    506         DO k = 1, ntra
    507           DO il = 1, ncum
    508             IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
    509                 (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
    510                 lwork(il)) THEN
    511               IF (Sij(il,i,j)>0.0) THEN
    512                 traent(il, i, i, k) = tra(il, nk(il), k)
    513               END IF
    514             END IF
    515           END DO
    516         END DO
     523!jyg!        DO k = 1, ntra
     524!jyg!          DO il = 1, ncum
     525!jyg!            IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
     526!jyg!                (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
     527!jyg!                lwork(il)) THEN
     528!jyg!              IF (Sij(il,i,j)>0.0) THEN
     529!jyg!                traent(il, i, i, k) = tra(il, nk(il), k)
     530!jyg!              END IF
     531!jyg!            END IF
     532!jyg!          END DO
     533!jyg!        END DO
    517534
    518535      END IF
    … …  
    568585    END DO ! il
    569586
    570     DO j = 1, ntra
    571       DO il = 1, ncum
    572         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
    573 ! cc     :     .and. csum(il,i).lt.m(il,i) ) then
    574           traent(il, i, i, j) = tra(il, nk(il), j)
    575         END IF
    576       END DO
    577     END DO
     587!jyg!    DO j = 1, ntra
     588!jyg!      DO il = 1, ncum
     589!jyg!        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
     590!jyg!! cc     :     .and. csum(il,i).lt.m(il,i) ) then
     591!jyg!          traent(il, i, i, j) = tra(il, nk(il), j)
     592!jyg!        END IF
     593!jyg!      END DO
     594!jyg!    END DO
    578595
    579596! ---------------------------------------------------------------

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

    r2374 r2393  
    592592  precip1(:) = 0.
    593593  cbmf1(:) = 0.
     594  plcl1(:) = 0.
     595  plfc1(:) = 0.
     596  wbeff1(:) = 0.
    594597  ptop21(:) = 0.
    595598  sigd1(:) = 0.
    … …  
    640643  sigij1(:, :, :) = 0.
    641644  elij1(:, :, :) = 0.
     645  wghti1(:,:) = 0.
    642646  phi21(:, :, :) = 0.
    643647  d1a1(:, :) = 0.
    … …  
    988992      PRINT *, ' cv_mixing ->'
    989993    END IF !(debut) THEN
    990 ! do i = 1,klev
    991 ! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
     994! do i = 1,nd
     995! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
    992996! enddo
    993997

  • LMDZ5/trunk/libf/phylmd/dyn1d/lmdz1d.F90

    r2373 r2393  
    88      PROGRAM lmdz1d
    99
    10       USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar
    11       use phys_state_var_mod
    12       use dimphy
    13       use surface_data, only : type_ocean,ok_veget
    14       use pbl_surface_mod, only : ftsoil, pbl_surface_init,                     &
     10   USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar
     11   USE phys_state_var_mod, ONLY : phys_state_var_init, phys_state_var_end, &
     12       clwcon, detr_therm, &
     13       qsol, fevap, z0m, z0h, agesno, &
     14       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
     15       falb_dir, falb_dif, &
     16       ftsol, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
     17       rlat, rlon, rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
     18       solsw, t_ancien, q_ancien, u_ancien, v_ancien, wake_cstar, wake_deltaq, &
     19       wake_deltat, wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
     20       wake_s, zgam, &
     21       zmax0, zmea, zpic, zsig, &
     22       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl
     23   use dimphy
     24   use surface_data, only : type_ocean,ok_veget
     25   use pbl_surface_mod, only : ftsoil, pbl_surface_init,                     &
    1526     &                            pbl_surface_final
    1627      use fonte_neige_mod, only : fonte_neige_init, fonte_neige_final
    1728
    18       use infotrac ! new
    19       use control_mod
    20       USE indice_sol_mod
    21       USE phyaqua_mod
    22       USE mod_1D_cases_read
    23       USE mod_1D_amma_read
    24       USE print_control_mod, ONLY: prt_level
    25       USE iniphysiq_mod, ONLY: iniphysiq
    26       USE mod_const_mpi, ONLY: comm_lmdz
     29   use infotrac ! new
     30   use control_mod
     31   USE indice_sol_mod
     32   USE phyaqua_mod
     33   USE mod_1D_cases_read
     34   USE mod_1D_amma_read
     35   USE print_control_mod, ONLY: prt_level
     36   USE iniphysiq_mod, ONLY: iniphysiq
     37   USE mod_const_mpi, ONLY: comm_lmdz
    2738
    2839      implicit none
    … …  
    127138!vertical advection computation
    128139!       real d_t_z(llm), d_q_z(llm)
    129 !       real d_t_dyn_z(llm), d_q_dyn_z(llm)
     140!       real d_t_dyn_z(llm), dq_dyn_z(llm)
    130141!       real zz(llm)
    131142!       real zfact
    … …  
    516527!      allocate(d_th_adv(llm))
    517528
     529      q(:,:) = 0.
     530      dq(:,:) = 0.
     531      dq_dyn(:,:) = 0.
     532      d_q_adv(:,:) = 0.
     533      d_q_nudge(:,:) = 0.
     534
    518535!
    519536!   No ozone climatology need be read in this pre-initialization
    … …  
    730747        solsw=0.
    731748        sollw=0.
     749        sollwdown=rsigma*tsurf**4
    732750        radsol=0.
    733751        rnebcon=0.
    734752        ratqs=0.
    735753        clwcon=0.
     754        zmax0 = 0.
    736755        zmea=0.
    737756        zstd=0.
    … …  
    742761        sig1=0.
    743762        w01=0.
     763        wake_cstar = 0.
     764        wake_deltaq = 0.
     765        wake_deltat = 0.
     766        wake_delta_pbl_TKE = 0.
     767        delta_tsurf = 0.
     768        wake_fip = 0.
     769        wake_pe = 0.
     770        wake_s = 0.
     771        ale_bl = 0.
     772        ale_bl_trig = 0.
     773        alp_bl = 0.
     774        IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
     775        IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
     776        entr_therm = 0.
     777        detr_therm = 0.
     778        f0 = 0.
     779        fm_therm = 0.
    744780        u_ancien(1,:)=u(:)
    745781        v_ancien(1,:)=v(:)
    … …  
    752788! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
    753789! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
    754 ! radsol,solsw,sollw,fder,rain_fall,snow_fall,frugs(:,nsrf)
     790! radsol,solsw,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
    755791! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
    756792! t_ancien,q_ancien,,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
    … …  
    939975         d_q_adv=0.0
    940976       endif
    941       print*, 'calcul de fcoriolis ', fcoriolis
     977!      print*, 'calcul de fcoriolis ', fcoriolis
    942978
    943979       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
    … …  
    949985        endif
    950986
    951       print*, 'fcoriolis ', fcoriolis, xlat,mxcalc
     987      IF (prt_level >= 1) print*, 'fcoriolis, xlat,mxcalc ', &
     988                                   fcoriolis, xlat,mxcalc
    952989
    953990       du_age(1:mxcalc)=fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
    954991       dv_age(1:mxcalc)=-fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
    955        print *,'u-ug=',u-ug
     992!       print *,'u-ug=',u-ug
    956993
    957994!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    960997       sfdt = sin(0.5*fcoriolis*timestep)
    961998       cfdt = cos(0.5*fcoriolis*timestep)
    962        print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
     999!       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
    9631000!
    9641001        du_age(1:mxcalc)= -2.*sfdt/timestep*                                &

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

    r2385 r2393  
    7171         o_tSTDlevs, epsfra, o_t_oce_sic, &
    7272         o_ale_bl, o_alp_bl, o_ale_wk, o_alp_wk, &
     73         o_dtvdf_x    , o_dtvdf_w    , o_dqvdf_x    , o_dqvdf_w    , &
     74         o_sens_x     , o_sens_w     , o_flat_x     , o_flat_w     , &
     75         o_delta_tsurf, &
     76         o_cdragh_x   , o_cdragh_w   , o_cdragm_x   , o_cdragm_w   , &
     77         o_kh         , o_kh_x       , o_kh_w       , &
    7378         o_ale, o_alp, o_cin, o_WAPE, o_wake_h, &
    7479         o_wake_s, o_wake_deltat, o_wake_deltaq, &
    … …  
    167172         sollwdownclr, lwdn0, ftsol, ustar, u10m, &
    168173         v10m, pbl_tke, wake_delta_pbl_TKE, &
     174         delta_tsurf, &
    169175         wstar, cape, ema_pcb, ema_pct, &
    170176         ema_cbmf, Ma, fm_therm, ale_bl, alp_bl, ale, &
    … …  
    197203         s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, &
    198204         vwriteSTD, wwriteSTD, phiwriteSTD, qwriteSTD, &
    199          twriteSTD, ale_wake, alp_wake, wake_h, &
     205         twriteSTD, ale_wake, alp_wake, &
     206         dtvdf_x    ,dtvdf_w    ,dqvdf_x    ,dqvdf_w    , &
     207         sens_x     ,sens_w     ,zxfluxlat_x,zxfluxlat_w, &
     208         cdragh_x   ,cdragh_w   ,cdragm_x   ,cdragm_w   , &
     209         kh         ,kh_x       ,kh_w       , &
     210         wake_h, &
    200211         wake_omg, d_t_wake, d_q_wake, Vprecip, &
    201212         wdtrainA, wdtrainM, n2, s2, proba_notrig, &
    … …  
    754765             CALL histwrite_phy(o_ale_wk, ale_wake)
    755766             CALL histwrite_phy(o_alp_wk, alp_wake)
     767             IF (iflag_pbl_split>=1) THEN
     768               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dtvdf_x(1:klon,1:klev)/pdtphys
     769               CALL histwrite_phy(o_dtvdf_x    ,zx_tmp_fi3d)
     770               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dtvdf_w(1:klon,1:klev)/pdtphys
     771               CALL histwrite_phy(o_dtvdf_w    ,zx_tmp_fi3d)
     772               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dqvdf_x(1:klon,1:klev)/pdtphys
     773               CALL histwrite_phy(o_dqvdf_x    ,zx_tmp_fi3d)
     774               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dqvdf_w(1:klon,1:klev)/pdtphys
     775               CALL histwrite_phy(o_dqvdf_w    ,zx_tmp_fi3d)
     776               CALL histwrite_phy(o_sens_x     ,sens_x     )
     777               CALL histwrite_phy(o_sens_w     ,sens_w     )
     778               CALL histwrite_phy(o_flat_x     ,zxfluxlat_x)
     779               CALL histwrite_phy(o_flat_w     ,zxfluxlat_w)
     780               CALL histwrite_phy(o_delta_tsurf,delta_tsurf)
     781               CALL histwrite_phy(o_cdragh_x   ,cdragh_x   )
     782               CALL histwrite_phy(o_cdragh_w   ,cdragh_w   )
     783               CALL histwrite_phy(o_cdragm_x   ,cdragm_x   )
     784               CALL histwrite_phy(o_cdragm_w   ,cdragm_w   )
     785               CALL histwrite_phy(o_kh         ,kh         )
     786               CALL histwrite_phy(o_kh_x       ,kh_x       )
     787               CALL histwrite_phy(o_kh_w       ,kh_w       )
     788             ENDIF   ! (iflag_pbl_split>=1)
    756789             CALL histwrite_phy(o_ale, ale)
    757790             CALL histwrite_phy(o_alp, alp)

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

    r2385 r2393  
    43224322     enddo
    43234323
    4324      write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
     4324!jyg<     (En attendant de statuer sur le sort de d_t_oli)
     4325!jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
     4326!jyg!     do k=1,klev
     4327!jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
     4328!jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
     4329!jyg!     enddo
     4330     write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    43254331     do k=1,klev
    4326         write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
     4332        write(lunout,*) d_t_vdf(igout,k), &
    43274333             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    43284334     enddo
     4335!>jyg
    43294336
    43304337     write(lunout,*) 'd_ps ',d_ps(igout)
Note: See TracChangeset for help on using the changeset viewer.