Changeset 230


Ignore:
Timestamp:
Jun 20, 2001, 3:29:52 PM (24 years ago)
Author:
lmdzadmin
Message:

Merge de la physique avec la branche principale
LF

Location:
LMDZ.3.3/branches/rel-LF/libf/phylmd
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/YOMCST.inc

    r112 r230  
    2020      REAL :: RALPD,RBETD,RGAMD
    2121!
    22       COMMON/YOMCST/RPI   ,RCLUM ,RHPLA ,RKBOL ,RNAVO &
    23      &      ,RDAY  ,REA   ,REPSM ,RSIYEA,RSIDAY,ROMEGA &
    24      &      ,R_ecc, R_peri, R_incl &
    25      &      ,RA    ,RG    ,R1SA &
    26      &      ,RSIGMA,RI0 &
    27      &      ,R     ,RMD   ,RMV   ,RD    ,RV    ,RCPD &
    28      &      ,RCPV  ,RCVD  ,RCVV  ,RKAPPA,RETV &
    29      &      ,RCW   ,RCS &
    30      &      ,RLVTT ,RLSTT ,RLMLT ,RTT   ,RATM &
    31      &      ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS &
    32      &      ,RALPD ,RBETD ,RGAMD
     22      COMMON/YOMCST/RPI ,RCLUM, RHPLA, RKBOL, RNAVO ,RDAY  ,REA &
     23     & ,REPSM ,RSIYEA,RSIDAY,ROMEGA ,R_ecc, R_peri, R_incl, RA    ,RG &
     24     & ,R1SA ,RSIGMA,RI0,R ,RMD   ,RMV   ,RD    ,RV    ,RCPD ,RCPV,RCVD &
     25     & ,RCVV  ,RKAPPA,RETV ,RCW   ,RCS ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM &
     26     & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS ,RALPD ,RBETD ,RGAMD

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F

    r223 r230  
     1c
     2c $Header$
     3c
     4
    15      SUBROUTINE clmain(dtime,itap,date0,pctsrf,
    26     .                  t,q,u,v,
    … …  
    728732      ENDDO
    729733      ENDDO
    730 
    731734      DO i = 1, knon
    732735         zx_buf1(i) = zx_coef(i,klev) + delp(i,klev)

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/condsurf.F

    r98 r230  
     1c $Header$
     2c
    13      SUBROUTINE condsurf( jour, jourvrai, pctsrf,
    24     s                    lmt_sst,lmt_alb,lmt_rug,lmt_bils )

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/conflx.F

    r79 r230  
    103103      DO k = 1, klev+1
    104104      DO i = 1, klon
    105          pmflxr(i,k) = 0.0
    106          pmflxs(i,k) = 0.0
     105         zmflxr(i,k) = 0.0
     106         zmflxs(i,k) = 0.0
    107107      ENDDO
    108108      ENDDO
    … …  
    981981      ENDDO
    982982c
     983      ldcum(1)=ldcum(1)
     984c
    983985      is = 0
    984986      DO i = 1, klon
    … …  
    10391041      REAL plude(klon,klev)
    10401042      REAL pdmfup(klon,klev), pdpmel(klon,klev)
    1041       REAL pdmfdp(klon,klev)
     1043cjq The variable maxpdmfdp(klon) has been introduced by Olivier Boucher
     1044cjq 14/11/00 to fix the problem with the negative precipitation.     
     1045      REAL pdmfdp(klon,klev), maxpdmfdp(klon,klev)
    10421046      REAL prfl(klon), psfl(klon)
    10431047      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
    10441048      INTEGER  kcbot(klon), kctop(klon), ktype(klon)
    10451049      LOGICAL  ldland(klon), ldcum(klon)
    1046       INTEGER k, i
     1050      INTEGER k, kp, i
    10471051      REAL zcons1, zcons2, zcucov, ztmelp2
    10481052      REAL pdtime, zdp, zzp, zfac, zsnmlt, zrfl, zrnew
    … …  
    11601164         ENDIF
    11611165         IF (pten(i,k).GT.RTT) THEN
    1162            pmflxr(i,k+1)=pmflxr(i,k)+pdmfup(i,k)+pdmfdp(i,k)+pdpmel(i,k)
     1166         pmflxr(i,k+1)=pmflxr(i,k)+pdmfup(i,k)+pdmfdp(i,k)+pdpmel(i,k)
     1167         pmflxs(i,k+1)=pmflxs(i,k)-pdpmel(i,k)
    11631168         ELSE
    1164            pmflxs(i,k+1)=pmflxs(i,k)+pdmfup(i,k)+pdmfdp(i,k)-pdpmel(i,k)
     1169           pmflxs(i,k+1)=pmflxs(i,k)+pdmfup(i,k)+pdmfdp(i,k)
     1170           pmflxr(i,k+1)=pmflxr(i,k)
    11651171         ENDIF
    11661172c        si la precipitation est negative, on ajuste le plux du
    … …  
    11761182      ENDDO
    11771183c
     1184cjq The new variable is initialized here.
     1185cjq It contains the humidity which is fed to the downdraft
     1186cjq by evaporation of precipitation in the column below the base
     1187cjq of convection.
     1188cjq
     1189cjq In the former version, this term has been subtracted from precip
     1190cjq as well as the evaporation.
     1191cjq     
     1192      DO k = 1, klev
     1193      DO i = 1, klon
     1194         maxpdmfdp(i,k)=0.0
     1195      ENDDO
     1196      ENDDO
     1197      DO k = 1, klev
     1198       DO kp = k, klev
     1199        DO i = 1, klon
     1200         maxpdmfdp(i,k)=maxpdmfdp(i,k)+pdmfdp(i,kp)
     1201        ENDDO
     1202       ENDDO
     1203      ENDDO
     1204cjq End of initialization
     1205c     
    11781206      DO k = ktopm2, klev
    11791207      DO i = 1, klon
    … …  
    11891217            zrfln=MAX(zrnew,0.)
    11901218            zdrfl=MIN(0.,zrfln-zrfl)
     1219cjq At least the amount of precipiation needed to feed the downdraft
     1220cjq with humidity below the base of convection has to be left and can't
     1221cjq be evaporated (surely the evaporation can't be positive):           
     1222            zdrfl=MAX(zdrfl,
     1223     .            MIN(-pmflxr(i,k)-pmflxs(i,k)-maxpdmfdp(i,k),0.0))
     1224cjq End of insertion
     1225c           
    11911226            zdenom=1.0/MAX(1.0E-20,pmflxr(i,k)+pmflxs(i,k))
    11921227            IF (pten(i,k).GT.RTT) THEN
    … …  
    12071242            pdmfdp(i,k) = 0.0
    12081243            pdpmel(i,k) = 0.0
    1209          ENDIF
     1244         ENDIF         
     1245         if (pmflxr(i,k) + pmflxs(i,k).lt.-1.e-26)
     1246     .    write(*,*) 'precip. < 1e-16 ',pmflxr(i,k) + pmflxs(i,k)
    12101247      ENDIF
    12111248      ENDDO

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp_tr.F

    r79 r230  
    1       SUBROUTINE fisrtilp_tr(dtime,paprs,pplay,t,q,
     1c $Header$
     2c
     3      SUBROUTINE fisrtilp_tr(dtime,paprs,pplay,t,q,ratqs,
    24     s                   d_t, d_q, d_ql, rneb, radliq, rain, snow,
    35     s                   pfrac_impa, pfrac_nucl, pfrac_1nucl,
    … …  
    6668      PARAMETER (coef_eva=2.0E-05)
    6769      LOGICAL calcrat ! calculer ratqs au lieu de fixer sa valeur
    68       REAL ratqs ! determine la largeur de distribution de vapeur
     70      REAL ratqs(klon,klev) ! determine la largeur de distribution de vapeur
    6971      PARAMETER (calcrat=.TRUE.)
    7072      REAL zx_min, rat_max
    … …  
    281283         DO i = 1, klon
    282284c
    283             zx = pplay(i,k)/paprs(i,1)
    284             zx = (zx_max-zx)/(zx_max-zx_min)
    285             zx = MIN(MAX(zx,0.0),1.0)
    286             zx = zx * zx * zx
    287             ratqs = zx * (rat_max-rat_min) + rat_min
    288             IF (.NOT.calcrat) ratqs=0.05
    289 c
    290             zdelq = ratqs * zq(i)
     285            zdelq = ratqs(i,k) * zq(i)
    291286            rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
    292287            zqn(i) = (zq(i)+zdelq+zqs(i))/2.0

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/indicesol.inc

    r118 r230  
    1       INTEGER,parameter :: nbsrf=4
     1      INTEGER, parameter :: nbsrf=4
    22      INTEGER, parameter :: is_oce=3 !ocean
    33      INTEGER, parameter :: is_sic = 4 ! glace de mer

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/initphysto.F

    r79 r230  
     1C
     2C $Header$
     3C
    14      subroutine initphysto
    25     .  (infile,
    … …  
    133136     .                "once", t_ops, t_wrt)
    134137
     138C T
     139C
     140      call histdef(fileid, 't', 'Temperature', 'K',
     141     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     142     .             32, 'inst(X)', t_ops, t_wrt)
     143        write(*,*) 'apres t ds initphysto'
    135144C mfu
    136145C
    … …  
    234243     .             32, "inst(X)", t_ops, t_wrt)
    235244       
    236        
     245c
     246c rain
     247c
     248        call histdef(fileid, "rain", " ", " ",
     249     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
     250     .             32, "inst(X)", t_ops, t_wrt)
     251
    237252c
    238253c psrf1

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

    r223 r230  
    281281      SAVE agesno                 ! age de la neige
    282282c
     283      REAL alb_neig(klon)
     284      SAVE alb_neig               ! albedo de la neige
     285cKE43
     286c Variables liees a la convection de K. Emanuel (sb):
     287c
     288      REAL ema_workcbmf(klon)   ! cloud base mass flux
     289      SAVE ema_workcbmf
     290
     291      REAL ema_cbmf(klon)       ! cloud base mass flux
     292      SAVE ema_cbmf
     293
     294      REAL ema_pcb(klon)        ! cloud base pressure
     295      SAVE ema_pcb
     296
     297      REAL ema_pct(klon)        ! cloud top pressure
     298      SAVE ema_pct
     299
     300      REAL bas, top             ! cloud base and top levels
     301      SAVE bas
     302      SAVE top
     303
     304      REAL Ma(klon,klev)        ! undilute upward mass flux
     305      SAVE Ma
     306      REAL ema_work1(klon, klev), ema_work2(klon, klev)
     307      SAVE ema_work1, ema_work2
     308      REAL wdn(klon), tdn(klon), qdn(klon)
     309c Variables locales pour la couche limite (al1):
     310c
     311cAl1      REAL pblh(klon)           ! Hauteur de couche limite
     312cAl1      SAVE pblh
     313c34EK
    283314c
    284315c Variables locales:
    … …  
    346377      EXTERNAL condsurf  ! lire les conditions aux limites
    347378      EXTERNAL conlmd    ! convection (schema LMD)
     379cKE43
     380      EXTERNAL conema  ! convect4.3
    348381      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
    349382cAA
    … …  
    426459c
    427460      REAL zphi(klon,klev)
     461      REAL zx_tmp_x(iim), zx_tmp_yjjmp1
     462      REAL zx_relief(iim,jjmp1)
     463      REAL zx_aire(iim,jjmp1)
     464cKE43
     465c Variables locales pour la convection de K. Emanuel (sb):
     466c
     467      REAL upwd(klon,klev)      ! saturated updraft mass flux
     468      REAL dnwd(klon,klev)      ! saturated downdraft mass flux
     469      REAL dnwd0(klon,klev)     ! unsaturated downdraft mass flux
     470      REAL tvp(klon,klev)       ! virtual temp of lifted parcel
     471      REAL cape(klon)           ! CAPE
     472      SAVE cape
     473      REAL pbase(klon)          ! cloud base pressure
     474      SAVE pbase
     475      REAL bbase(klon)          ! cloud base buoyancy
     476      SAVE bbase
     477      REAL rflag(klon)          ! flag fonctionnement de convect
     478c -- convect43:
     479      INTEGER ntra              ! nb traceurs pour convect4.3
     480      REAL pori_con(klon)    ! pressure at the origin level of lifted parcel
     481      REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
     482      REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
     483      REAL dplcldt(klon), dplcldr(klon)
     484c?     .     condm_con(klon,klev),conda_con(klon,klev),
     485c?     .     mr_con(klon,klev),ep_con(klon,klev)
     486c?     .    ,sadiab(klon,klev),wadiab(klon,klev)
     487c --
     488c34EK
    428489c
    429490c Variables du changement
    … …  
    460521      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
    461522      REAL d_t_lif(klon,klev)
     523
     524      REAL ratqs(klon,klev)
     525      LOGICAL zpt_conv(klon,klev)
     526
    462527c
    463528c Variables liees a l'ecriture de la bande histoire physique
    … …  
    595660         PRINT*, "Clef pour la convection, iflag_con=", iflag_con
    596661c
     662cKE43
     663c Initialisation pour la convection de K.E. (sb):
     664         IF (iflag_con.EQ.4) THEN
     665
     666         PRINT*, "*** Convection de Kerry Emanuel 4.3  "
     667         PRINT*, "On va utiliser le melange convectif des traceurs qui"
     668         PRINT*, "est calcule dans convect4.3"
     669         PRINT*, " !!! penser aux logical flags de phytrac"
     670
     671          DO i = 1, klon
     672           ema_cbmf(i) = 0.
     673           ema_pcb(i)  = 0.
     674           ema_pct(i)  = 0.
     675           ema_workcbmf(i) = 0.
     676          ENDDO
     677         ENDIF
     678c34EK
    597679         IF (ok_orodr) THEN
    598680         DO i=1,klon
    … …  
    665747     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
    666748     .                 nhori, nid_day)
    667 c         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
    668 c     .                 klev, presnivs, nvert)
    669          call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
    670      .              klev, znivsig, nvert)
     749         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
     750     .                 klev, presnivs, nvert)
     751c        call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
     752c    .              klev, znivsig, nvert)
    671753c
    672754         zsto = dtime
    … …  
    888970     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
    889971     .                 nhori, nid_mth)
    890 c         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
    891 c     .                 klev, presnivs, nvert)
    892          call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
    893      .              klev, znivsig, nvert)
     972         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
     973     .                 klev, presnivs, nvert)
     974c        call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
     975c    .              klev, znivsig, nvert)
    894976c
    895977         zsto = dtime
    … …  
    10971179     .                "ave(X)", zsto,zout)
    10981180c
     1181cKE43
     1182      IF (iflag_con .EQ. 4) THEN ! sb
     1183c
     1184         CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
     1185     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     1186     .                "ave(X)", zsto,zout)
     1187c
     1188         CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
     1189     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     1190     .                "ave(X)", zsto,zout)
     1191c
     1192         CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
     1193     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     1194     .                "ave(X)", zsto,zout)
     1195c
     1196         CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
     1197     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     1198     .                "ave(X)", zsto,zout)
     1199c
     1200c
     1201      ENDIF
     1202c34EK
     1203c
    10991204c Champs 3D:
    11001205c
    … …  
    11781283     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
    11791284     .                "ave(X)", zsto,zout)
     1285
     1286         CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
     1287     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     1288     .                "ave(X)", zsto,zout)
     1289
     1290         CALL histdef(nid_mth, "ratqs", "RATQS"," ",
     1291     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     1292     .                "ave(X)", zsto,zout)
     1293
    11801294c
    11811295         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
    … …  
    12501364         ENDIF
    12511365c
     1366cKE43
     1367      IF (iflag_con.EQ.4) THEN ! (sb)
     1368c
     1369         CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
     1370     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
     1371     .                "ave(X)", zsto,zout)
     1372c
     1373         CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
     1374     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
     1375     .                "ave(X)", zsto,zout)
     1376c
     1377         CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
     1378     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
     1379     .                "ave(X)", zsto,zout)
     1380c
     1381         CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
     1382     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
     1383     .                "ave(X)", zsto,zout)
     1384c
     1385c
     1386      ENDIF
     1387c34EK
    12521388         CALL histend(nid_mth)
    12531389c
    … …  
    12751411     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
    12761412     .                 nhori, nid_ins)
    1277 c         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
    1278 c     .                 klev, presnivs, nvert)
    1279          call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
    1280      .              klev, znivsig, nvert)
     1413         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
     1414     .                 klev, presnivs, nvert)
     1415c        call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
     1416c    .              klev, znivsig, nvert)
    12811417c
    12821418c
    … …  
    16851821c
    16861822      DO nsrf = 1, nbsrf
    1687       DO i = 1, klon
    1688          IF (pctsrf(i,nsrf).LT.epsfra) ftsol(i,nsrf) = zxtsol(i)
    1689       ENDDO
     1823        DO i = 1, klon
     1824          IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
     1825        ENDDO
    16901826      ENDDO
    16911827
    … …  
    17501886c    s             d_t_con, d_q_con,
    17511887c    s             rain_con, snow_con, ibas_con, itop_con)
     1888cKE43
     1889      ELSE IF (iflag_con.EQ.4) THEN
     1890c nb of tracers for the KE convection:
     1891          if (nqmax .GE. 4) then
     1892              ntra = nbtr
     1893          else
     1894              ntra = 1
     1895          endif
     1896cke43 (arguments inutiles enleves => des SAVE dans conema43?)
     1897c$$$          CALL conema43(dtime,paprs,pplay,t_seri,q_seri,
     1898c$$$     $        u_seri,v_seri,tr_seri,nbtr,
     1899c$$$     .        ema_workcbmf,
     1900c$$$     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
     1901c$$$     .        wdn, tdn, qdn,
     1902c$$$     .        rain_con, snow_con, ibas_con, itop_con,
     1903c$$$     .        upwd,dnwd,dnwd0,bas,top,Ma,cape,tvp,rflag,
     1904c$$$     .        pbase
     1905c$$$     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
     1906c$$$     .        pori_con,plcl_con,dtma_con,dtlcl_con)
     1907          CALL conema (dtime,paprs,pplay,t_seri,q_seri,
     1908     $        u_seri,v_seri,tr_seri,nbtr,
     1909     .        ema_work1,ema_work2,
     1910     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
     1911c$$$     .        wdn, tdn, qdn,
     1912     .        rain_con, snow_con, ibas_con, itop_con,
     1913     .        upwd,dnwd,dnwd0,bas,top,Ma,cape,tvp,rflag,
     1914     .        pbase
     1915     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
     1916c$$$     .        pori_con,plcl_con,dtma_con,dtlcl_con)
     1917          DO i = 1, klon
     1918            ema_pcb(i)  = pbase(i)
     1919          ENDDO
     1920          DO i = 1, klon
     1921            ema_pct(i)  = paprs(i,itop_con(i))
     1922          ENDDO
     1923          DO i = 1, klon
     1924            ema_cbmf(i) = ema_workcbmf(i)
     1925          ENDDO     
    17521926      ELSE
    1753       PRINT*, "iflag_con non-prevu", iflag_con
    1754       CALL abort
     1927          PRINT*, "iflag_con non-prevu", iflag_con
     1928          CALL abort
    17551929      ENDIF
    17561930
    … …  
    17661940      ENDDO
    17671941      IF (check) THEN
    1768          za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
    1769          PRINT*, "aprescon=", za
    1770          zx_t = 0.0
    1771          za = 0.0
    1772          DO i = 1, klon
     1942          za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
     1943          PRINT*, "aprescon=", za
     1944          zx_t = 0.0
     1945          za = 0.0
     1946          DO i = 1, klon
    17731947            za = za + paire(i)/FLOAT(klon)
    17741948            zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
    1775         ENDDO
    1776          zx_t = zx_t/za*dtime
    1777          PRINT*, "Precip=", zx_t
     1949          ENDDO
     1950          zx_t = zx_t/za*dtime
     1951          PRINT*, "Precip=", zx_t
    17781952      ENDIF
    17791953      IF (zx_ajustq) THEN
    1780          DO i = 1, klon
     1954          DO i = 1, klon
    17811955            z_apres(i) = 0.0
    1782          ENDDO
    1783          DO k = 1, klev
    1784          DO i = 1, klon
    1785             z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
    1786      .                        *(paprs(i,k)-paprs(i,k+1))/RG
    1787          ENDDO
    1788          ENDDO
    1789          DO i = 1, klon
    1790          z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
    1791      .                /z_apres(i)
    1792          ENDDO
    1793          DO k = 1, klev
    1794          DO i = 1, klon
    1795          IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
    1796      .       z_factor(i).LT.(1.0-1.0E-08)) THEN
    1797                q_seri(i,k) = q_seri(i,k) * z_factor(i)
    1798          ENDIF
    1799          ENDDO
    1800          ENDDO
     1956          ENDDO
     1957          DO k = 1, klev
     1958            DO i = 1, klon
     1959              z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
     1960     .            *(paprs(i,k)-paprs(i,k+1))/RG
     1961            ENDDO
     1962          ENDDO
     1963          DO i = 1, klon
     1964            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
     1965     .          /z_apres(i)
     1966          ENDDO
     1967          DO k = 1, klev
     1968            DO i = 1, klon
     1969              IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
     1970     .            z_factor(i).LT.(1.0-1.0E-08)) THEN
     1971                  q_seri(i,k) = q_seri(i,k) * z_factor(i)
     1972              ENDIF
     1973            ENDDO
     1974          ENDDO
    18011975      ENDIF
    18021976      zx_ajustq=.FALSE.
    … …  
    18041978      IF (nqmax.GT.2) THEN !--melange convectif de traceurs
    18051979c
    1806       IF (iflag_con.NE.2) THEN
    1807          PRINT*, "Pour l instant, seul conflx fonctionne avec traceurs"
    1808          PRINT*,' Mettre iflag_con = 2  dans  run.def et repasser  !'
    1809          CALL abort
    1810       ENDIF
     1980          IF (iflag_con .NE. 2 .AND.  iflag_con .NE. 4 ) THEN
     1981              PRINT*, 'Pour l instant, seul conflx fonctionne ',
     1982     $            'avec traceurs', iflag_con
     1983              PRINT*,' Mettre iflag_con',
     1984     $            ' = 2  ou 4 dans run.def et repasser'
     1985              CALL abort
     1986              ENDIF
    18111987c
    18121988      ENDIF !--nqmax.GT.2
    … …  
    18211997      ENDDO
    18221998      ENDDO
     1999
     2000c   RATQS
     2001      call calcratqs (
     2002     I            paprs,pplay,q_seri,d_t_con,d_t_ajs
     2003     O           ,ratqs,zpt_conv)
    18232004c
    18242005c Appeler le processus de condensation a grande echelle
    … …  
    18262007c
    18272008      CALL fisrtilp_tr(dtime,paprs,pplay,
    1828      .           t_seri, q_seri,
     2009     .           t_seri, q_seri,ratqs,
    18292010     .           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
    18302011     .           rain_lsc, snow_lsc,
    … …  
    20602241c   Calcul  des tendances traceurs
    20612242c====================================================================
     2243C Pascale : il faut quand meme apeller phytrac car il gere les sorties
     2244cKE43       des traceurs => il faut donc mettre des flags a .false.
     2245      IF (iflag_con.EQ.4) THEN
     2246c           on ajoute les tendances calculees par KE43
     2247        DO iq=1, nqmax-2 ! Sandrine a -3 ???
     2248        DO k = 1, nlev
     2249        DO i = 1, klon
     2250          tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
     2251        ENDDO
     2252        ENDDO
     2253        WRITE(iqn,'(i2.2)') iq
     2254        CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
     2255        ENDDO
    20622256CMAF modif pour garder info du nombre de traceurs auxquels
    20632257C la physique s'applique
     2258      ELSE
     2259CMAF modif pour garder info du nombre de traceurs auxquels
     2260C la physique s'applique
    20642261C
    20652262      call phytrac (rnpb,
    2066      I                   debut,
     2263     I                   debut,lafin,
    20672264     I                   nqmax-2,
    20682265     I                   nlon,nlev,dtime,
    … …  
    20732270     I                   rlon,presnivs,paire,pphis,
    20742271     O                   tr_seri)
     2272      ENDIF
    20752273
    20762274      IF (offline) THEN
    … …  
    20782276         call phystokenc (
    20792277     I                   nlon,nlev,pdtphys,rlon,rlat,
    2080      I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
     2278     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    20812279     I                   ycoefh,yu1,yv1,ftsol,pctsrf,
    20822280     I                   frac_impa, frac_nucl,
    2083      I                   pphis,paire,dtime,itap,
    2084      O                   physid)
     2281     I                   pphis,paire,dtime,itap)
     2282
    20852283
    20862284      ENDIF
    … …  
    24752673      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
    24762674      CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2675cKE43
     2676      IF (iflag_con .EQ. 4) THEN ! sb
     2677c
     2678      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
     2679      CALL histwrite(nid_mth,"cape",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2680c
     2681      CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
     2682      CALL histwrite(nid_mth,"pbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2683c
     2684      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
     2685      CALL histwrite(nid_mth,"ptop",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2686c
     2687      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
     2688      CALL histwrite(nid_mth,"fbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2689c
     2690c
     2691      ENDIF
     2692c34EK
    24772693c
    24782694c Champs 3D:
    … …  
    25572773      CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
    25582774     .                                   iim*jjmp1*klev,ndex3d)
     2775c
     2776      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zpt_conv, zx_tmp_3d)
     2777      CALL histwrite(nid_mth,"ptconv",itap,zx_tmp_3d,
     2778     .                                   iim*(jjm+1)*klev,ndex3d)
     2779c
     2780      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, ratqs, zx_tmp_3d)
     2781      CALL histwrite(nid_mth,"ratqs",itap,zx_tmp_3d,
     2782     .                                   iim*(jjm+1)*klev,ndex3d)
    25592783c
    25602784      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
    … …  
    26282852      ENDDO
    26292853      ENDIF
     2854cKE43
     2855      IF (iflag_con.EQ.4) THEN ! (sb)
     2856c
     2857      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
     2858      CALL histwrite(nid_mth,"upwd",itap,zx_tmp_3d,
     2859     .                                   iim*jjmp1*klev,ndex3d)
     2860c
     2861      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
     2862      CALL histwrite(nid_mth,"dnwd",itap,zx_tmp_3d,
     2863     .                                   iim*jjmp1*klev,ndex3d)
     2864c
     2865      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
     2866      CALL histwrite(nid_mth,"dnwd0",itap,zx_tmp_3d,
     2867     .                                   iim*jjmp1*klev,ndex3d)
     2868c
     2869      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
     2870      CALL histwrite(nid_mth,"Ma",itap,zx_tmp_3d,
     2871     .                                   iim*jjmp1*klev,ndex3d)
     2872c
     2873c
     2874      ENDIF
     2875c34EK
    26302876c
    26312877      if (ok_sync) then

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/phystokenc.F

    r177 r230  
     1c
     2c $Header$
     3c
    14      SUBROUTINE phystokenc (
    25     I                   nlon,nlev,pdtphys,rlon,rlat,
    3      I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
     6     I                   pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    47     I                   pcoefh,yu1,yv1,ftsol,pctsrf,
    5      I                   frac_impa,frac_nucl,
    6      I                   pphis,paire,dtime,itap,
    7      O                   physid)
     8     I                   pfrac_impa,pfrac_nucl,
     9     I                   pphis,paire,dtime,itap)
    810      USE ioipsl
    911      USE histcom
    … …  
    3638      real pdtphys ! pas d'integration pour la physique (seconde)
    3739c
    38       integer physid, itap
    39       integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
     40      integer physid, itap,ndex(1)
    4041
    4142c   convection:
    … …  
    4849      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
    4950      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
     51        REAL pt(klon,klev)
    5052c
    5153      REAL rlon(klon), rlat(klon), dtime
    … …  
    6264c   ----------
    6365c
    64       REAL frac_impa(klon,klev)
    65       REAL frac_nucl(klon,klev)
     66      REAL pfrac_impa(klon,klev)
     67      REAL pfrac_nucl(klon,klev)
    6668c
    6769c Arguments necessaires pour les sources et puits de traceur
    … …  
    8082      REAL de_d(klon,klev) ! flux detraine dans le panache descendant
    8183      REAL coefh(klon,klev) ! flux detraine dans le panache descendant
     84        REAL t(klon,klev)
     85      REAL frac_impa(klon,klev)
     86      REAL frac_nucl(klon,klev)
     87      REAL rain(klon)
    8288
    8389      REAL pyu1(klon),pyv1(klon)
    … …  
    9096      integer iadvtr,irec
    9197      real zmin,zmax
    92       logical ok_sync
    93  
    94       save mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
     98
     99      save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
    95100      save iadvtr,irec
     101      save frac_impa,frac_nucl,rain
    96102      save pyu1,pyv1,pftsol,ppsrf
    97103
    … …  
    101107c======================================================================
    102108
    103       ok_sync = .true.
    104 
    105 c     print*,'iadvtr= ',iadvtr
    106 c     print*,'istphy= ',istphy
    107 c     print*,'istdyn= ',istdyn
     109      print*,'iadvtr= ',iadvtr
     110      print*,'istphy= ',istphy
     111      print*,'istdyn= ',istdyn
    108112
    109113      IF (iadvtr.eq.0) THEN
    … …  
    112116     . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid)
    113117       
    114 c       write(*,*) 'apres initphysto ds phystokenc'
    115 
     118        write(*,*) 'apres initphysto ds phystokenc'
     119
     120       ndex(1) = 0
     121         i=itap
     122         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
     123         CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
     124c
     125         i=itap
     126         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
     127         CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
    116128       
    117129      ENDIF
    118130c
    119       ndex2d = 0
    120       ndex3d = 0
    121       i=itap
    122       CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
    123       CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
    124 c
    125       i=itap
    126       CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
    127       CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
    128 
    129131      iadvtr=iadvtr+1
    130132c
    131       IF(mod(iadvtr,istphy).eq.0) THEN
    132 c
    133 c   normalisation par le temps cumule
     133c
     134c   reinitialisation des champs cumules
     135      if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then
     136        print*,'reinitialisation des champs cumules
     137     s          a iadvtr=',iadvtr
    134138         do k=1,klev
    135139            do i=1,klon
    136                mfu(i,k)=mfu(i,k)/dtcum
    137                mfd(i,k)=mfd(i,k)/dtcum
    138                en_u(i,k)=en_u(i,k)/dtcum
    139                de_u(i,k)=de_u(i,k)/dtcum
    140                en_d(i,k)=en_d(i,k)/dtcum
    141                de_d(i,k)=de_d(i,k)/dtcum
    142                coefh(i,k)=coefh(i,k)/dtcum
    143             enddo
    144          enddo
    145          do i=1,klon
    146             pyv1(i)=pyv1(i)/dtcum
    147             pyu1(i)=pyu1(i)/dtcum
    148          end do
    149          do k=1,nbsrf
    150              do i=1,klon
    151                pftsol(i,k)=pftsol(i,k)/dtcum
    152                pftsol1(i) = pftsol(i,1)
    153                pftsol2(i) = pftsol(i,2)
    154                pftsol3(i) = pftsol(i,3)
    155                pftsol4(i) = pftsol(i,4)
    156 
    157                ppsrf(i,k)=ppsrf(i,k)/dtcum
    158                ppsrf1(i) = ppsrf(i,1)
    159                ppsrf2(i) = ppsrf(i,2)
    160                ppsrf3(i) = ppsrf(i,3)
    161                ppsrf4(i) = ppsrf(i,4)
    162 
    163             enddo
    164          enddo
    165 c
    166 c   ecriture des champs
    167 c
    168          irec=irec+1
    169 
    170 ccccc
    171          CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
    172       CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
    173      .                                   iim*(jjm+1)*klev,ndex3d)
    174         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
    175       CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
    176      .                                   iim*(jjm+1)*klev,ndex3d)
    177         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
    178       CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
    179      .                                   iim*(jjm+1)*klev,ndex3d)
    180         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
    181       CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
    182      .                                   iim*(jjm+1)*klev,ndex3d)
    183         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
    184       CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
    185      .                                   iim*(jjm+1)*klev,ndex3d)
    186         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)       
    187       CALL histwrite(physid,"de_d",itap,zx_tmp_3d,   
    188      .                                   iim*(jjm+1)*klev,ndex3d)
    189         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)         
    190       CALL histwrite(physid,"coefh",itap,zx_tmp_3d,   
    191      .                                   iim*(jjm+1)*klev,ndex3d)       
    192 cccc
    193        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
    194         CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
    195      .  iim*(jjm+1)*klev,ndex3d)
    196 
    197         CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
    198         CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
    199      .  iim*(jjm+1)*klev,ndex3d)
    200  
    201         CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
    202       CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),
    203      .                                                ndex2d)
    204        
    205         CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
    206       CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1)
    207      .                                                ,ndex2d)
    208        
    209         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
    210       CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
    211      .                                   iim*(jjm+1),ndex2d)
    212          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
    213       CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
    214      .                                   iim*(jjm+1),ndex2d)
    215           CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
    216       CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
    217      .                                   iim*(jjm+1),ndex2d)
    218          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
    219       CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
    220      .                                   iim*(jjm+1),ndex2d)
    221 
    222         CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
    223       CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,   
    224      .                                   iim*(jjm+1),ndex2d)
    225         CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
    226       CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
    227      .                                   iim*(jjm+1),ndex2d)
    228         CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
    229       CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
    230      .                                   iim*(jjm+1),ndex2d)
    231         CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
    232       CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
    233      .                                   iim*(jjm+1),ndex2d)
    234 
    235       if (ok_sync) call histsync(physid)
    236        
    237 c
    238 cAA Test sur la valeur des coefficients de lessivage
    239 c
    240          zmin=1e33
    241          zmax=-1e33
    242          do k=1,klev
    243             do i=1,klon
    244                   zmax=max(zmax,frac_nucl(i,k))
    245                   zmin=min(zmin,frac_nucl(i,k))
    246             enddo
    247          enddo
    248          Print*,'------ coefs de lessivage (min et max) --------'
    249          Print*,'facteur de nucleation ',zmin,zmax
    250          zmin=1e33
    251          zmax=-1e33
    252          do k=1,klev
    253             do i=1,klon
    254                   zmax=max(zmax,frac_impa(i,k))
    255                   zmin=min(zmin,frac_impa(i,k))
    256             enddo
    257          enddo
    258          Print*,'facteur d impaction ',zmin,zmax
    259 
    260       ENDIF
    261 
    262 c   reinitialisation des champs cumules
    263       if (mod(iadvtr,istphy).eq.1) then
    264          do k=1,klev
    265             do i=1,klon
     140               frac_impa(i,k)=1.
     141               frac_nucl(i,k)=1.
    266142               mfu(i,k)=0.
    267143               mfd(i,k)=0.
    … …  
    271147               de_d(i,k)=0.
    272148               coefh(i,k)=0.
     149                t(i,k)=0.
    273150            enddo
    274151         enddo
    275152         do i=1,klon
     153            rain(i)=0.
    276154            pyv1(i)=0.
    277155            pyu1(i)=0.
    … …  
    289167      do k=1,klev
    290168         do i=1,klon
     169            frac_impa(i,k)=frac_impa(i,k)*pfrac_impa(i,k)
     170            frac_nucl(i,k)=frac_nucl(i,k)*pfrac_nucl(i,k)
    291171            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
    292172            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
    … …  
    296176            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
    297177            coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
     178                t(i,k)=t(i,k)+pt(i,k)*pdtphys
    298179         enddo
    299180      enddo
    … …  
    310191
    311192      dtcum=dtcum+pdtphys
     193c
     194      IF(mod(iadvtr,istphy).eq.0) THEN
     195c
     196c   normalisation par le temps cumule
     197         do k=1,klev
     198            do i=1,klon
     199c              frac_impa=frac_impa : c'est la fraction cumulee qu'on stoke
     200c              frac_nucl=frac_nucl : c'est la fraction cumulee qu'on stoke
     201               mfu(i,k)=mfu(i,k)/dtcum
     202               mfd(i,k)=mfd(i,k)/dtcum
     203               en_u(i,k)=en_u(i,k)/dtcum
     204               de_u(i,k)=de_u(i,k)/dtcum
     205               en_d(i,k)=en_d(i,k)/dtcum
     206               de_d(i,k)=de_d(i,k)/dtcum
     207               coefh(i,k)=coefh(i,k)/dtcum
     208                t(i,k)=t(i,k)/dtcum
     209            enddo
     210         enddo
     211         do i=1,klon
     212            rain(i)=rain(i)/dtcum
     213            pyv1(i)=pyv1(i)/dtcum
     214            pyu1(i)=pyu1(i)/dtcum
     215         end do
     216c modif abderr 23 11 00         do k=1,nbsrf
     217             do i=1,klon
     218              do k=1,nbsrf
     219               pftsol(i,k)=pftsol(i,k)/dtcum
     220               ppsrf(i,k)=ppsrf(i,k)/dtcum
     221              enddo
     222               pftsol1(i) = pftsol(i,1)
     223               pftsol2(i) = pftsol(i,2)
     224               pftsol3(i) = pftsol(i,3)
     225               pftsol4(i) = pftsol(i,4)
     226
     227c               ppsrf(i,k)=ppsrf(i,k)/dtcum
     228               ppsrf1(i) = ppsrf(i,1)
     229               ppsrf2(i) = ppsrf(i,2)
     230               ppsrf3(i) = ppsrf(i,3)
     231               ppsrf4(i) = ppsrf(i,4)
     232
     233            enddo
     234c         enddo
     235c
     236c   ecriture des champs
     237c
     238         irec=irec+1
     239
     240ccccc
     241      print*,'AVANT ECRITURE'
     242         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
     243         CALL histwrite(physid,"t",itap,zx_tmp_3d,
     244     .                                   iim*(jjm+1)*klev,ndex)
     245      print*,'APRES ECRITURE'
     246
     247         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
     248      CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
     249     .                                   iim*(jjm+1)*klev,ndex)
     250        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
     251      CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
     252     .                                   iim*(jjm+1)*klev,ndex)
     253        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
     254      CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
     255     .                                   iim*(jjm+1)*klev,ndex)
     256        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
     257      CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
     258     .                                   iim*(jjm+1)*klev,ndex)
     259        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
     260      CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
     261     .                                   iim*(jjm+1)*klev,ndex)
     262        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)
     263      CALL histwrite(physid,"de_d",itap,zx_tmp_3d,
     264     .                                   iim*(jjm+1)*klev,ndex)
     265        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)
     266      CALL histwrite(physid,"coefh",itap,zx_tmp_3d,
     267     .                                   iim*(jjm+1)*klev,ndex)
     268cccc
     269       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
     270        CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
     271     .  iim*(jjm+1)*klev,ndex)
     272
     273        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
     274        CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
     275     .  iim*(jjm+1)*klev,ndex)
     276
     277        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
     278      CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
     279
     280        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
     281      CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
     282
     283        CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
     284      CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
     285     .                                   iim*(jjm+1),ndex)
     286         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
     287      CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
     288     .                                   iim*(jjm+1),ndex)
     289          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
     290      CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
     291     .                                   iim*(jjm+1),ndex)
     292
     293c
     294         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
     295      CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
     296     .                                   iim*(jjm+1),ndex)
     297
     298        CALL gr_fi_ecrit(1,klon,iim,jjm+1, rain, zx_tmp_2d)
     299      CALL histwrite(physid,"rain",itap,zx_tmp_2d,
     300     .                                   iim*(jjm+1),ndex)
     301
     302        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
     303      CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,
     304     .                                   iim*(jjm+1),ndex)
     305        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
     306      CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
     307     .                                   iim*(jjm+1),ndex)
     308        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
     309      CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
     310     .                                   iim*(jjm+1),ndex)
     311        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
     312      CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
     313     .                                   iim*(jjm+1),ndex)
     314
     315c
     316cAA Test sur la valeur des coefficients de lessivage
     317c
     318         zmin=1e33
     319         zmax=-1e33
     320         do k=1,klev
     321            do i=1,klon
     322                  zmax=max(zmax,frac_nucl(i,k))
     323                  zmin=min(zmin,frac_nucl(i,k))
     324            enddo
     325         enddo
     326         Print*,'------ coefs de lessivage (min et max) --------'
     327         Print*,'facteur de nucleation ',zmin,zmax
     328         zmin=1e33
     329         zmax=-1e33
     330         do k=1,klev
     331            do i=1,klon
     332                  zmax=max(zmax,frac_impa(i,k))
     333                  zmin=min(zmin,frac_impa(i,k))
     334            enddo
     335         enddo
     336         Print*,'facteur d impaction ',zmin,zmax
     337
     338      ENDIF
     339
    312340
    313341      RETURN

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/phytrac.F

    r177 r230  
     1c
     2c $Header$
     3c
    14      SUBROUTINE phytrac (rnpb,
    2      I                   debutphy,
     5     I                   debutphy,lafin,
    36     I                   nqmax,
    47     I                   nlon,nlev,pdtphys,
    … …  
    2932#include "dimphy.h"
    3033#include "indicesol.h"
     34#include "temps.h"
    3135#include "control.h"
    32 #include "temps.h"
    3336c======================================================================
    3437
    … …  
    5053      real pplay(nlon,nlev)  ! pression pour le mileu de chaque couche (en Pa)
    5154      real presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
    52       real znivsig(klev) ! niveaux sigma
    5355      real paire(klon)
    5456      real pphis(klon)
    5557      logical debutphy       ! le flag de l'initialisation de la physique
     58      logical lafin          ! le flag de la fin de la physique
     59
    5660      integer ll
    5761c
    … …  
    9296      real ftsol(nlon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
    9397      real pctsrf(nlon,nbsrf) ! Pourcentage de sol f(nature du sol)
    94 
     98c abder
     99      real pftsol1(nlon),pftsol2(nlon),pftsol3(nlon),pftsol4(nlon)
     100      real ppsrf1(nlon),ppsrf2(nlon),ppsrf3(nlon),ppsrf4(nlon)
     101c fin
    95102cAA ----------------------------
    96103cAA  VARIABLES LOCALES TRACEURS
    … …  
    133140      INTEGER nid_tra
    134141      SAVE nid_tra
    135       INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
     142c     REAL x(klon,klev,nbtr+2) ! traceurs
     143      INTEGER ndex(1)
    136144      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
    137145      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
    … …  
    161169c
    162170c--modif convection tiedtke
    163       INTEGER i, k, it
    164 
     171      INTEGER i, k, it,itap
     172        save itap
    165173      REAL delp(klon,klev)
    166174c--end modif
    … …  
    208216c        print*,'DANS PHYTRAC debutphy=',debutphy
    209217
    210          ecrit_tra = NINT(86400./pdtphys *ecritphy)   
    211          zsto = pdtphys
    212          zout = pdtphys * FLOAT(ecrit_tra)
    213218         if (debutphy) then
     219
     220          print*,'dans phytrac ',pdtphys,ecritphy,ecrit_tra
     221          ecrit_tra = NINT(86400./pdtphys/2.) ! tous les 12H
     222c         ecrit_tra = NINT(86400./pdtphys) ! tous les 24H
    214223
    215224         if(nbtr.lt.nqmax) then
    … …  
    223232         PRINT*, 'La frequence de sortie traceurs est  ', ecrit_tra
    224233         itra=0
     234         itap=0
    225235C         
    226236         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
    … …  
    239249     .                 1,iim,1,jjm+1, 0, zjulian, pdtphys,
    240250     .                 nhori, nid_tra)
    241          call histvert(nid_tra, 'sig_s', 'Niveaux sigma','-',
    242      .              klev, znivsig, nvert)
    243 C
    244 C         CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
    245 C     .                 klev, presnivs, nvert)
     251         CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
     252     .                 klev, presnivs, nvert)
     253         zsto = pdtphys
     254         zout = pdtphys * FLOAT(ecrit_tra)
    246255c
    247256         CALL histdef(nid_tra, "phis", "Surface geop. height", "-",
    … …  
    252261     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
    253262     .                "once",  zsto,zout)
     263
     264        goto 666
     265         CALL histdef(nid_tra, "pyu1", "Vent niv 1", "-",
     266     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     267     .                "inst(X)",  zsto,zout)
     268
     269         CALL histdef(nid_tra, "pyv1", "Vent niv 1", "-",
     270     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     271     .                "inst(X)",  zsto,zout)
     272         CALL histdef(nid_tra, "psrf1", "nature sol", "-",
     273     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     274     .                "inst(X)",  zsto,zout)
     275         CALL histdef(nid_tra, "psrf2", "nature sol", "-",
     276     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     277     .                "inst(X)",  zsto,zout)
     278         CALL histdef(nid_tra, "psrf3", "nature sol", "-",
     279     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     280     .                "inst(X)",  zsto,zout)
     281         CALL histdef(nid_tra, "psrf4", "nature sol", "-",
     282     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     283     .                "inst(X)",  zsto,zout)
     284         CALL histdef(nid_tra, "ftsol1", "temper sol", "-",
     285     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     286     .                "inst(X)",  zsto,zout)
     287         CALL histdef(nid_tra, "ftsol2", "temper sol", "-",
     288     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     289     .                "inst(X)",  zsto,zout)
     290         CALL histdef(nid_tra, "ftsol3", "temper sol", "-",
     291     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     292     .                "inst",  zsto,zout)
     293         CALL histdef(nid_tra, "ftsol4", "temper sol", "-",
     294     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     295     .                "inst(X)",  zsto,zout)
     296         CALL histdef(nid_tra, "pplay", "flux u mont","-",
     297     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     298     .                "inst(X)", zsto,zout)
     299         CALL histdef(nid_tra, "t", "flux u mont","-",
     300     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     301     .                "inst(X)", zsto,zout)
     302         CALL histdef(nid_tra, "mfu", "flux u mont","-",
     303     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     304     .                "ave(X)", zsto,zout)
     305         CALL histdef(nid_tra, "mfd", "flux u decen","-",
     306     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     307     .                "ave(X)", zsto,zout)
     308         CALL histdef(nid_tra, "en_u", "flux u mont","-",
     309     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     310     .                "ave(X)", zsto,zout)
     311         CALL histdef(nid_tra, "en_d", "flux u mont","-",
     312     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     313     .                "ave(X)", zsto,zout)
     314         CALL histdef(nid_tra, "de_u", "flux u mont","-",
     315     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     316     .                "ave(X)", zsto,zout)
     317         CALL histdef(nid_tra, "de_d", "flux u mont","-",
     318     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     319     .                "ave(X)", zsto,zout)
     320         CALL histdef(nid_tra, "coefh", "turbulent coef","-",
     321     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     322     .                "ave(X)", zsto,zout)
     323
     324666     continue
    254325c
    255326         DO it=1,nqmax
    … …  
    271342         ENDDO
    272343         CALL histend(nid_tra)
     344         ndex(1) = 0
     345c
     346         i = NINT(zout/zsto)
     347         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
     348         CALL histwrite(nid_tra,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
     349C
     350         i = NINT(zout/zsto)
     351         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
     352         CALL histwrite(nid_tra,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
    273353
    274354c======================================================================
    … …  
    284364            enddo
    285365         END DO
     366
     367         open (99,file='starttrac',status='old',
     368     .         err=999,form='formatted')
     369         read(99,*) (trs(i,1),i=1,klon)
     370999      close(99)
     371         print*, 'apres starttrac'
     372
    286373c Initialisation de la fraction d'aerosols lessivee
    287374c
    … …  
    317404         inirnpb=.false.
    318405      endif
     406      if(nqmax.gt.2) aerosol(3)=.true.
     407
     408
     409c  abder
     410        goto 777
     411            do i=1,nlon
     412               pftsol1(i) = ftsol(i,1)
     413               pftsol2(i) = ftsol(i,2)
     414               pftsol3(i) = ftsol(i,3)
     415               pftsol4(i) = ftsol(i,4)
     416
     417               ppsrf1(i) = pctsrf(i,1)
     418               ppsrf2(i) = pctsrf(i,2)
     419               ppsrf3(i) = pctsrf(i,3)
     420               ppsrf4(i) = pctsrf(i,4)
     421
     422            enddo
     423         ndex(1)=0
     424         itap=itap+1
     425         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yu1,zx_tmp_2d)
     426         CALL histwrite(nid_tra,"pyu1",itap,zx_tmp_2d,
     427     s                                  iim*(jjm+1),ndex)
     428         
     429         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yv1,zx_tmp_2d)
     430         CALL histwrite(nid_tra,"pyv1",itap,zx_tmp_2d,
     431     s                                  iim*(jjm+1),ndex)
     432
     433         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol1,zx_tmp_2d)
     434         CALL histwrite(nid_tra,"ftsol1",itap,zx_tmp_2d,
     435     s                                       iim*(jjm+1),ndex)
     436
     437         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol2,zx_tmp_2d)
     438         CALL histwrite(nid_tra,"ftsol2",itap,zx_tmp_2d,
     439     s                                       iim*(jjm+1),ndex)
     440
     441         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol3,zx_tmp_2d)
     442         CALL histwrite(nid_tra,"ftsol3",itap,zx_tmp_2d,
     443     s                                      iim*(jjm+1),ndex)
     444
     445         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol4,zx_tmp_2d)
     446         CALL histwrite(nid_tra,"ftsol4",itap,zx_tmp_2d,
     447     s                                      iim*(jjm+1),ndex)
     448
     449         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf1,zx_tmp_2d)
     450         CALL histwrite(nid_tra,"psrf1",itap,zx_tmp_2d,
     451     s                                     iim*(jjm+1),ndex)
     452
     453         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf2,zx_tmp_2d)
     454         CALL histwrite(nid_tra,"psrf2",itap,zx_tmp_2d,
     455     s                                     iim*(jjm+1),ndex)
     456
     457         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf3,zx_tmp_2d)
     458         CALL histwrite(nid_tra,"psrf3",itap,zx_tmp_2d,
     459     s                                     iim*(jjm+1),ndex)
     460
     461         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf4,zx_tmp_2d)
     462         CALL histwrite(nid_tra,"psrf4",itap,zx_tmp_2d,
     463     s                                     iim*(jjm+1),ndex)
     464777     continue
    319465c======================================================================
    320466c   Calcul de l'effet de la convection
    321467c======================================================================
     468        print*,'Avant convection'
     469      do it=1,nqmax
     470         WRITE(itn,'(i1)') it
     471c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
     472      enddo
    322473
    323474      if (convection) then
    324475
    325 c     print*,'Pas de temps dans phytrac : ',pdtphys
     476      print*,'Pas de temps dans phytrac : ',pdtphys
    326477      DO it=1, nqmax
    327478      CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    … …  
    332483      ENDDO
    333484      ENDDO
    334       WRITE(itn,'(i1)') it
    335       CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn)
    336       ENDDO
    337 c     print*,'apres nflxtr'
     485c      WRITE(itn,'(i1)') it
     486c      CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn)
     487      ENDDO
     488c      print*,'apres nflxtr'
    338489
    339490
    340491      endif ! convection
     492c        print*,'Apres convection'
     493c      do it=1,nqmax
     494c         WRITE(itn,'(i1)') it
     495c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
     496c      enddo
    341497
    342498c======================================================================
    343499c   Calcul de l'effet de la couche limite
    344500c======================================================================
    345 
    346 c     print*,'avant couchelimite'
     501c       print *,'Avant couchelimite'
     502c      do it=1,nqmax
     503c         WRITE(itn,'(i1)') it
     504c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
     505c      enddo
     506
    347507      if (couchelimite) then
    348508
    … …  
    403563      endif ! couche limite
    404564
    405 c     print*,'apres couchelimite'
     565c      print*,'Apres couchelimite'
     566c      do it=1,nqmax
     567c         WRITE(itn,'(i1)') it
     568c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
     569c      enddo
    406570
    407571c======================================================================
    … …  
    432596c======================================================================
    433597
     598      print*,'LESSIVAGE =',lessivage
    434599      IF (lessivage) THEN
    435600
    … …  
    464629c Mise a jour due a l'impaction et a la nucleation
    465630c
     631c      call dump2d(iim,jjm-1,frac_impa(2:klon-1,10),'FRACIMPA')
     632c      call dump2d(iim,jjm-1,frac_nucl(2:klon-1,10),'FRACNUCL')
     633c      call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3')
    466634       DO it = 1, nqmax
     635c         print*,'IT=',it,aerosol(it)
    467636         IF (aerosol(it)) THEN
     637c           print*,'IT=',it,' On lessive'
    468638           DO k = 1, nlev
    469639              DO i = 1, klon
    470                tr_seri(i,k,it) = tr_seri(i,k,it) *
    471      s              ( frac_impa(i,k) + frac_nucl(i,k) - 1. )   
     640               tr_seri(i,k,it)=tr_seri(i,k,it)
     641     s         *frac_impa(i,k)*frac_nucl(i,k)
    472642              ENDDO
    473643           ENDDO
    474644         ENDIF
    475645       ENDDO
     646c      call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3B')
    476647c
    477648c Flux lessivage total
    … …  
    507678      ENDDO
    508679      itra=itra+1
    509 
    510 C
    511 C Sorties IOIPSL
    512       ndex2d = 0
    513       ndex3d = 0
    514 c
    515 c     write(*,*)'sorties ioipsl phytrac',zsto,zout
    516       CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
    517       CALL histwrite(nid_tra,"phis",itra,zx_tmp_2d,iim*(jjm+1),ndex2d)
    518 C
    519       CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
    520       CALL histwrite(nid_tra,"aire",itra,zx_tmp_2d,iim*(jjm+1),ndex2d)
     680      ndex(1) = 0
    521681      DO it=1,nqmax
    522682      IF (it.LE.99) THEN
    … …  
    525685       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
    526686       CALL histwrite(nid_tra,"tr"//str2,itra,zx_tmp_3d,
    527      .                                   iim*(jjm+1)*klev,ndex3d)
    528        IF (lessivage) THEN
    529        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
    530        CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d,
    531      .                                   iim*(jjm+1)*klev,ndex3d)
    532       ENDIF
     687     .                                   iim*(jjm+1)*klev,ndex)
     688c      IF (lessivage) THEN
     689c      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
     690c      CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d,
     691c    .                                   iim*(jjm+1)*klev,ndex)
     692c     ENDIF
    533693      ELSE
    534694         PRINT*, "Trop de traceurs"
    … …  
    536696      ENDIF
    537697      ENDDO
    538       if (ok_sync) call histsync(nid_tra)
     698
     699        goto 888
     700        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay,zx_tmp_3d)
     701        CALL histwrite(nid_tra,"pplay",itra,zx_tmp_3d,
     702     .                  iim*(jjm+1)*klev,ndex)
     703
     704        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,t_seri,zx_tmp_3d)
     705        CALL histwrite(nid_tra,"t",itra,zx_tmp_3d,
     706     .                  iim*(jjm+1)*klev,ndex)
     707        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfu,zx_tmp_3d)
     708        CALL histwrite(nid_tra,"mfu",itra,zx_tmp_3d,
     709     .                  iim*(jjm+1)*klev,ndex)
     710        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfd,zx_tmp_3d)
     711        CALL histwrite(nid_tra,"mfd",itra,zx_tmp_3d,
     712     .                  iim*(jjm+1)*klev,ndex)
     713        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_u,zx_tmp_3d)
     714        CALL histwrite(nid_tra,"en_u",itra,zx_tmp_3d,
     715     .                  iim*(jjm+1)*klev,ndex)
     716        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_d,zx_tmp_3d)
     717        CALL histwrite(nid_tra,"en_d",itra,zx_tmp_3d,
     718     .                  iim*(jjm+1)*klev,ndex)
     719        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_d,zx_tmp_3d)
     720        CALL histwrite(nid_tra,"de_d",itra,zx_tmp_3d,
     721     .                  iim*(jjm+1)*klev,ndex)
     722        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_u,zx_tmp_3d)
     723        CALL histwrite(nid_tra,"de_u",itra,zx_tmp_3d,
     724     .                  iim*(jjm+1)*klev,ndex)
     725        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,coefh,zx_tmp_3d)
     726        CALL histwrite(nid_tra,"coefh",itra,zx_tmp_3d,
     727     .                  iim*(jjm+1)*klev,ndex)
     728
     729888     continue
     730
     731c       print*,'Sortie phytrac'
     732c      do it=1,nqmax
     733c         WRITE(itn,'(i1)') it
     734c        call diagtracphy(tr_seri(:,:,it),paprs,'Fin Phys  '//itn)
     735c      enddo
     736
     737      if (lafin) then
     738         print*, 'c est la fin de la physique'
     739         open (99,file='restarttrac',  form='formatted')
     740         do i=1,klon
     741             write(99,*) trs(i,1)
     742         enddo
     743         PRINT*, 'Ecriture du fichier restarttrac'
     744         close(99)
     745      else
     746         print*, 'physique pas fini'
     747      endif
     748
    539749
    540750      RETURN

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.h

    r2 r230  
    11      INTEGER kdlon, kflev
    2       PARAMETER (kdlon=149,kflev=klev)
     2c
     3ccc      PARAMETER (kdlon=klon,kflev=klev)
     4c
     5c resolution 72 45:
     6      PARAMETER (kdlon=317,kflev=klev)
     7c resolution 64 32:
     8ccc      PARAMETER (kdlon=331,kflev=klev)
     9c resolution 96 49:
     10ccc      PARAMETER (kdlon=461,kflev=klev)
     11c resolution 144 73:
     12ccc      PARAMETER (kdlon=610,kflev=klev)
     13c resolution 96 72:
     14c      PARAMETER (kdlon=487,kflev=klev)
     15c resolution 128 64:
     16ccc       PARAMETER (kdlon=4033,kflev=klev)
Note: See TracChangeset for help on using the changeset viewer.