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.

File:
1 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)
Note: See TracChangeset for help on using the changeset viewer.