Ignore:
Timestamp:
Apr 4, 2006, 5:03:00 PM (18 years ago)
Author:
lmdzadmin
Message:

Ajout diagnostiques rh, tpot a 2m et wbilo +
lecture flag ip_ebil_phy dans conf_phys.F90
IM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r678 r687  
    4242#define histmth
    4343#define histins
    44 #define histISCCP
    45 #define histREGDYN
    46 #define histmthNMC
     44c #define histISCCP
     45c #define histmthNMC
    4746c======================================================================
    4847c    modif   ( P. Le Van ,  12/10/98 )
    … …  
    7069c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
    7170c omega---input-R-vitesse verticale en Pa/s
    72 c
     71cIM comgeomphy.h BEG
     72c cuphy----input-R-resolution des mailles en x (m)
     73c cvphy----input-R-resolution des mailles en y (m)
     74cIM comgeomphy.h END
    7375c d_u-----output-R-tendance physique de "u" (m/s/s)
    7476c d_v-----output-R-tendance physique de "v" (m/s/s)
    … …  
    125127cIM "slab" ocean
    126128      REAL tslab(klon)    !Temperature du slab-ocean
    127       SAVE tslab
     129cIM      SAVE tslab
    128130      REAL seaice(klon)   !glace de mer (kg/m2)
    129       SAVE seaice
     131cIM      SAVE seaice
    130132      REAL fluxo(klon)    !flux turbulents ocean-glace de mer
    131133      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
    132 c
     134cIM
     135      REAL amn, amx
    133136c======================================================================
    134137c Clef controlant l'activation du cycle diurne:
    … …  
    250253#include "raddim.h"
    251254c
    252 cIM 080304   REAL swdn0(klon,2), swdn(klon,2), swup0(klon,2), swup(klon,2)
    253255      REAL swdn0(klon,klevp1), swdn(klon,klevp1)
    254256      REAL swup0(klon,klevp1), swup(klon,klevp1)
    … …  
    380382      INTEGER imin_debut, nbpti
    381383      INTEGER jmin_debut, nbptj
    382 c
    383       REAL nbsunlit(nregISCtot,klon)  !nbsunlit : moyenne de sunlit
    384       INTEGER ncol, seed(klon)
    385 
     384cIM parametres ISCCP BEG
     385      INTEGER nbapp_isccp,isccppas
     386      INTEGER n, napisccp
     387c     PARAMETER(napisccp=3)
     388      PARAMETER(napisccp=1)
     389      INTEGER ifreq_isccp(napisccp), freqin_pdt(napisccp)
     390      DATA ifreq_isccp/3/
     391      SAVE ifreq_isccp
     392      CHARACTER*5 typinout(napisccp)
     393      DATA typinout/'i3od'/
     394cIM verif boxptop BEG
     395      CHARACTER*1 verticaxe(napisccp)
     396      DATA verticaxe/'1'/
     397cIM verif boxptop END
     398      INTEGER nvlev(napisccp)
     399c     INTEGER nvlev
     400      REAL t1, aa
     401      REAL seed_re(klon,napisccp)
     402      INTEGER seed_old(klon,napisccp)
     403      SAVE seed_old
     404      INTEGER iphy(iim,jjmp1)
     405cIM parametres ISCCP END
     406c
    386407c ncol = nb. de sous-colonnes pour chaque maille du GCM
    387 c     PARAMETER(ncol=100)
    388 c     PARAMETER(ncol=625)
    389 c     PARAMETER(ncol=10)
    390       PARAMETER(ncol=25)
     408c ncolmx = No. max. de sous-colonnes pour chaque maille du GCM
     409      INTEGER ncol(napisccp), ncolmx, seed(klon,napisccp)
     410      REAL nbsunlit(nregISCtot,klon,napisccp)  !nbsunlit : moyenne de sunlit
     411      PARAMETER(ncolmx=1500)
     412c
     413cIM verif boxptop BEG
     414      REAL vertlev(ncolmx,napisccp)
     415cIM verif boxptop END
     416c
    391417      REAL tautab(0:255)
    392418      INTEGER invtau(-20:45000)
    … …  
    413439      REAL dem_sH2B(klon,klev)
    414440      REAL dem_cH2B(klon,klev)
    415 
    416 c output from ISCCP simulator
    417       REAL fq_isccp(klon,7,7)
    418       REAL totalcldarea(klon)
    419       REAL meanptop(klon)
    420       REAL meantaucld(klon)
    421       REAL boxtau(klon,ncol)
    422       REAL boxptop(klon,ncol)
    423 c
    424       INTEGER l, kmax, lmax
    425       PARAMETER(kmax=8, lmax=8)
     441c
     442      INTEGER kmax, lmax, lmax3
     443      PARAMETER(kmax=8, lmax=8, lmax3=3)
    426444      INTEGER kmaxm1, lmaxm1
    427445      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
    … …  
    430448     .jjmp1x7=jjmp1*lmaxm1)
    431449c
     450c output from ISCCP simulator
     451      REAL fq_isccp(klon,kmaxm1,lmaxm1,napisccp)
     452      REAL fq_is_true(klon,kmaxm1,lmaxm1,napisccp)
     453      REAL totalcldarea(klon,napisccp)
     454      REAL meanptop(klon,napisccp)
     455      REAL meantaucld(klon,napisccp)
     456      REAL boxtau(klon,ncolmx,napisccp)
     457      REAL boxptop(klon,ncolmx,napisccp)
     458      REAL zx_tmp_fi3d_bx(klon,ncolmx)
     459      REAL zx_tmp_3d_bx(iim,jjmp1,ncolmx)
     460c
     461      REAL cld_fi3d(klon,lmax3)
     462      REAL cld_3d(iim,jjmp1,lmax3)
     463c
    432464      INTEGER iw, iwmax
    433465      REAL wmin, pas_w
    434466c     PARAMETER(wmin=-100.,pas_w=10.,iwmax=30)
    435       PARAMETER(wmin=-200.,pas_w=10.,iwmax=40)
     467cIM 051005     PARAMETER(wmin=-200.,pas_w=10.,iwmax=40)
     468      PARAMETER(wmin=-100.,pas_w=10.,iwmax=20)
    436469      REAL o500(klon)
    437470c
    … …  
    440473      INTEGER nreg, nbregdyn
    441474      PARAMETER(nbregdyn=5)
    442       REAL histoW(kmaxm1,lmaxm1,iwmax,nbregdyn)
    443       REAL nhistoW(kmaxm1,lmaxm1,iwmax,nbregdyn)
    444       REAL nhistoWt(kmaxm1,lmaxm1,iwmax,nbregdyn)
    445       SAVE nhistoWt
     475cIM 051005 BEG
     476c     REAL histoW(iwmax,nbregdyn,napisccp)
     477c     REAL nhistoW(iwmax,nbregdyn,napisccp)
     478c     REAL histoWn(iwmax,nbregdyn)
     479c     REAL nhistoWn(iwmax,nbregdyn)
     480cIM 090905 END
    446481
    447482      INTEGER linv
    448483      INTEGER pct_ocean(klon,nbregdyn)
     484      SAVE pct_ocean
    449485 
    450486c sorties ISCCP
    … …  
    455491c     save ok_isccp, ecrit_isccp, nid_isccp       
    456492      save nid_isccp       
    457 cIM 090704 BEG
    458       INTEGER nbapp_isccp,isccppas
    459493
    460494#undef histISCCP
    … …  
    467501cIM 190504 #endif
    468502
    469 c sorties statistiques regime dynamique
    470 c     logical ok_regdyn
    471 c     real ecrit_regdyn
    472       integer nid_regdyn
    473 c     save ok_regdyn, ecrit_regdyn, nid_regdyn
    474       save nid_regdyn
    475 
    476 #undef histREGDYN
    477 #define histREGDYN
    478 cIM 190504 #ifdef histREGDYN
    479 c     data ok_regdyn,ecrit_regdyn/.true.,0.125/
    480 c     data ok_regdyn,ecrit_regdyn/.true.,1./
    481 cIM 190504    data ok_regdyn/.true./
    482 cIM 190504 #else
    483 cIM 190504   data ok_regdyn/.false./
    484 cIM 190504 #endif
    485 
    486503      REAL zx_tau(kmaxm1), zx_pc(lmaxm1), zx_o500(iwmax)
    487504      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./
    488       DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
     505cIM bad 151205     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
     506      DATA zx_pc/180., 310., 440., 560., 680., 800., 1000./
    489507
    490508c cldtopres pression au sommet des nuages
    491       REAL cldtopres(lmaxm1)
    492       DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
     509      REAL cldtopres(lmaxm1), cldtopres3(lmax3)
     510cIM 151205 erreur     DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
     511      DATA cldtopres/180., 310., 440., 560., 680., 800., 1000./
     512      DATA cldtopres3/440., 680., 1000./
     513cIM 051005 BEG
     514      REAL tmp_his1_3d(iwmax,kmaxm1,lmaxm1,nbregdyn,napisccp)
     515      REAL tmp_his2_3d(iwmax,kmaxm1,lmaxm1,nbregdyn,napisccp)
     516      REAL tmp_his3_3d(iwmax,kmaxm1,lmaxm1,nbregdyn,napisccp)
     517cIM 051005 END
    493518
    494519      INTEGER komega, nhoriRD
    … …  
    503528c cnameisccp
    504529      CHARACTER *27 cnameisccp(lmaxm1,kmaxm1)
    505       DATA cnameisccp/'pc< 50hPa, tau< 0.3',
    506      .                'pc= 50-180hPa, tau< 0.3',
     530cIM bad 151205     DATA cnameisccp/'pc< 50hPa, tau< 0.3',
     531      DATA cnameisccp/'pc= 50-180hPa, tau< 0.3',
    507532     .                'pc= 180-310hPa, tau< 0.3',
    508533     .                'pc= 310-440hPa, tau< 0.3',
    … …  
    510535     .                'pc= 560-680hPa, tau< 0.3',
    511536     .                'pc= 680-800hPa, tau< 0.3',
    512      .                'pc< 50hPa, tau= 0.3-1.3',
     537     .                'pc= 800-1000hPa, tau< 0.3',
    513538     .                'pc= 50-180hPa, tau= 0.3-1.3',
    514539     .                'pc= 180-310hPa, tau= 0.3-1.3',
    … …  
    517542     .                'pc= 560-680hPa, tau= 0.3-1.3',
    518543     .                'pc= 680-800hPa, tau= 0.3-1.3',
    519      .                'pc< 50hPa, tau= 1.3-3.6',
     544     .                'pc= 800-1000hPa, tau= 0.3-1.3',
    520545     .                'pc= 50-180hPa, tau= 1.3-3.6',
    521546     .                'pc= 180-310hPa, tau= 1.3-3.6',
    … …  
    524549     .                'pc= 560-680hPa, tau= 1.3-3.6',
    525550     .                'pc= 680-800hPa, tau= 1.3-3.6',
    526      .                'pc< 50hPa, tau= 3.6-9.4',
     551     .                'pc= 800-1000hPa, tau= 1.3-3.6',
    527552     .                'pc= 50-180hPa, tau= 3.6-9.4',
    528553     .                'pc= 180-310hPa, tau= 3.6-9.4',
    … …  
    531556     .                'pc= 560-680hPa, tau= 3.6-9.4',
    532557     .                'pc= 680-800hPa, tau= 3.6-9.4',
    533      .                'pc< 50hPa, tau= 9.4-23',
     558     .                'pc= 800-1000hPa, tau= 3.6-9.4',
    534559     .                'pc= 50-180hPa, tau= 9.4-23',
    535560     .                'pc= 180-310hPa, tau= 9.4-23',
    … …  
    538563     .                'pc= 560-680hPa, tau= 9.4-23',
    539564     .                'pc= 680-800hPa, tau= 9.4-23',
    540      .                'pc< 50hPa, tau= 23-60',
     565     .                'pc= 800-1000hPa, tau= 9.4-23',
    541566     .                'pc= 50-180hPa, tau= 23-60',
    542567     .                'pc= 180-310hPa, tau= 23-60',
    … …  
    545570     .                'pc= 560-680hPa, tau= 23-60',
    546571     .                'pc= 680-800hPa, tau= 23-60',
    547      .                'pc< 50hPa, tau> 60.',
     572     .                'pc= 800-1000hPa, tau= 23-60',
    548573     .                'pc= 50-180hPa, tau> 60.',
    549574     .                'pc= 180-310hPa, tau> 60.',
    … …  
    551576     .                'pc= 440-560hPa, tau> 60.',
    552577     .                'pc= 560-680hPa, tau> 60.',
    553      .                'pc= 680-800hPa, tau> 60.'/
     578     .                'pc= 680-800hPa, tau> 60.',
     579     .                'pc= 800-1000hPa, tau> 60.'/
    554580c
    555581c     REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7)
    … …  
    562588c
    563589      logical ok_hf
    564 cIM200505     integer ecrit_hf
    565 cIM200505    integer ecrit_hf2mth
    566 cIM200505    save ecrit_hf2mth
    567590c
    568591      integer nid_hf, nid_hf3d
    569 cIM200505     save ok_hf, ecrit_hf, nid_hf, nid_hf3d
    570592      save ok_hf, nid_hf, nid_hf3d
    571593
    572594c  QUESTION : noms de variables ?
    573595
     596#undef histhf
     597#define histhf
    574598#ifdef histhf
    575599cIM 130904   data ok_hf,ecrit_hf/.true.,0.25/
    … …  
    623647      REAL ftsol(klon,nbsrf)
    624648      SAVE ftsol                  ! temperature du sol
     649cIM
     650      REAL newsst(klon) !temperature de l'ocean
     651      SAVE newsst
    625652c
    626653      REAL ftsoil(klon,nsoilmx,nbsrf)
    … …  
    778805cym
    779806      REAL bils(klon) ! bilan de chaleur au sol
     807      REAL wfbilo(klon,nbsrf) ! bilan d'eau, pour chaque
     808C                             ! type de sous-surface et pondere par la fraction
    780809      REAL wfbils(klon,nbsrf) ! bilan de chaleur au sol, pour chaque
    781810C                             ! type de sous-surface et pondere par la fraction
    … …  
    810839      REAL wo(klon,klev)
    811840      SAVE wo                     ! ozone
     841cIM sorties
     842      REAL un_jour
     843      PARAMETER(un_jour=86400.)
    812844c======================================================================
    813845c
    … …  
    924956      REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
    925957      real zqsat(klon,klev)
    926       INTEGER i, k, iq, ig, j, nsrf, ll, iiq
     958      INTEGER i, k, iq, ig, j, nsrf, ll, l, iiq
    927959      REAL t_coup
    928960      PARAMETER (t_coup=234.0)
    … …  
    10501082c
    10511083c======================================================================
    1052 cIM200505     INTEGER ecrit_mth
    1053 cIM200505     SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
    10541084c
    10551085cIM cf. AM 081204 BEG
    … …  
    10681098
    10691099c
    1070 cIM200505     INTEGER ecrit_day
    1071 cIM200505     SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
    1072 c
    1073 cIM200505     INTEGER ecrit_ins
    1074 cIM200505     SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
    1075 c
    1076 cIM200505     INTEGER ecrit_reg
    1077 cIM200505     SAVE ecrit_reg   ! frequence d'ecriture
    1078 c
    10791100      integer itau_w   ! pas de temps ecriture = itap + itau_phy
    10801101c
    … …  
    10901111
    10911112      REAL zx_rh(klon,klev)
     1113cIM RH a 2m (la surface)
     1114      REAL rh2m(klon), qsat2m(klon)
     1115      REAL zx_rh2m(klon,nbsrf), zx_qsat2m(klon,nbsrf)
     1116      REAL zx_qs1(klon,nbsrf), zx_t1(klon,nbsrf), zdelta1(klon,nbsrf)
     1117      REAL zcor1(klon,nbsrf)
     1118      REAL tpot(klon), tpote(klon)
     1119      REAL Lheat
    10921120
    10931121      INTEGER        length
    … …  
    10961124c
    10971125      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
     1126cIM
     1127      INTEGER ndex2d1(iwmax)
    10981128c
    10991129cIM AMIP2 BEG
    … …  
    11271157c
    11281158      INTEGER nid_day, nid_mth, nid_ins, nid_nmc, nid_day_seri
     1159      INTEGER nid_ctesGCM
    11291160      SAVE nid_day, nid_mth, nid_ins, nid_nmc, nid_day_seri
     1161      SAVE nid_ctesGCM
    11301162c
    11311163cIM 280405 BEG
    … …  
    11401172cIM 280405 END
    11411173c
    1142       INTEGER nhori, nvert, nvert1
    1143 c     REAL zstok
    1144       REAL zsto, zout, zsto1, zsto2
    1145 c     REAL zstoave, zstoin
    1146       REAL zstophy, zstorad, zstohf, zstoday, zstomth
     1174      INTEGER nhori, nvert, nvert1, nvert3
     1175      REAL zsto, zsto1, zsto2
     1176      REAL zstophy, zstorad, zstohf, zstoday, zstomth, zout
     1177      REAL zcals(napisccp), zcalh(napisccp), zoutj(napisccp)
     1178      REAL zout_isccp(napisccp)
     1179      SAVE zcals, zcalh, zoutj, zout_isccp
     1180
    11471181      real zjulian
    11481182      save zjulian
    … …  
    11761210      REAL      zero_v(klon)
    11771211      CHARACTER*15 ztit
    1178       INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
    1179       SAVE      ip_ebil
    1180       DATA      ip_ebil/0/
    1181       INTEGER   if_ebil ! level for energy conserv. dignostics
    1182       SAVE      if_ebil
     1212
    11831213c+jld ec_conser
    11841214      REAL d_t_ec(klon,klev)    ! tendance du a la conersion Ec -> E thermique
    … …  
    12451275         SAVE clwcon0
    12461276         SAVE paire_ter
    1247          SAVE nhistoW
    1248          SAVE histoW
     1277c        SAVE nhistoW
     1278c        SAVE histoW
    12491279c SAVE anne 20/09/2005
    12501280         SAVE pblh
    … …  
    12671297#include "YOETHF.h"
    12681298#include "FCTTRE.h"
     1299cIM 100106 BEG : pouvoir sortir les ctes de la physique
     1300#include "conema3.h"
     1301#include "fisrtilp.h"
     1302#include "nuage.h"
     1303#include "compbl.h"
     1304cIM 100106 END : pouvoir sortir les ctes de la physique
     1305c
    12691306c======================================================================
    12701307      modname = 'physiq'
    1271       IF (if_ebil.ge.1) THEN
     1308cIM
     1309      IF (ip_ebil_phy.ge.1) THEN
    12721310        DO i=1,klon
    12731311          zero_v(i)=0.
    … …  
    13191357         clwcon(:,:) = 0.0
    13201358         paire_ter(:) = 0.0
    1321          nhistoW(:,:,:,:) = 0.0
    1322          histoW(:,:,:,:) = 0.0
     1359c        nhistoW(:,:,:,:) = 0.0
     1360c        histoW(:,:,:,:) = 0.0
    13231361! fin anne
    13241362! Anne 12/09/2005
    … …  
    13391377         wfbils(:,:)=0
    13401378cym     
    1341          IF (if_ebil.ge.1) d_h_vcol_phy=0.
     1379cIM     
     1380         IF (ip_ebil_phy.ge.1) d_h_vcol_phy=0.
    13421381c
    13431382c appel a la lecture du run.def physique
    … …  
    13451384         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel,
    13461385     .                  ok_instan, fact_cldcon, facttemps,ok_newmicro,
    1347      .                  iflag_cldcon,ratqsbas,ratqshaut, if_ebil,
     1386cIM  .                  iflag_cldcon,ratqsbas,ratqshaut, if_ebil,
     1387     .                  iflag_cldcon,ratqsbas,ratqshaut,
    13481388     .                  ok_ade, ok_aie,
    13491389     .                  bl95_b0, bl95_b1,
    … …  
    13631403     .       ocean, tslab,seaice,
    13641404     .       fqsurf,qsol,fsnow,
    1365      .       falbe, falblw, fevap, rain_fall,snow_fall,solsw, sollwdown,
     1405cIM 220306  .       falbe, falblw, fevap, rain_fall,snow_fall,solsw, sollwdown,
     1406     .       falbe, falblw, fevap, rain_fall,snow_fall,solsw, sollw,
    13661407     .       dlw,radsol,frugs,agesno,clesphy0,
    13671408     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
    … …  
    14251466
    14261467         WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3  "
     1468         WRITE(lunout,*)
     1469     .      "On va utiliser le melange convectif des traceurs qui"
     1470         WRITE(lunout,*)"est calcule dans convect4.3"
     1471         WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
    14271472
    14281473          DO i = 1, klon
    … …  
    15001545cIM200505    .                   ecrit_reg
    15011546cIM200505        ENDIF
    1502 c
    1503 cIM 230505 BEG
    1504          ecrit_ins = NINT(ecrit_ins/dtime)
    1505          ecrit_hf = NINT(ecrit_hf/dtime)
    1506 c        ecrit_hf2mth = 4*30
    1507          ecrit_day = NINT(ecrit_day/dtime)
    1508          ecrit_mth = NINT(ecrit_mth/dtime)
    1509          ecrit_tra = NINT(86400.*ecrit_tra/dtime)
    1510          ecrit_reg = NINT(ecrit_reg/dtime)
    1511 cIM 230505 END
     1547cIM 030306 BEG
     1548cIM ecrit_hf2mth = nombre de pas de temps de calcul de hf par mois apres lequel on ecrit
     1549cIM : ne pas modifier ecrit_hf2mth
     1550c
     1551         ecrit_hf2mth = 30*1/ecrit_hf
     1552c ecrit_ins, ecrit_tra en secondes, chaque pas de temps de la physique
     1553         ecrit_ins = dtime
     1554         ecrit_tra = dtime
     1555cIM on passe les frequences de jours en secondes : ecrit_ins, ecrit_hf, ecrit_day, ecrit_mth, ecrit_tra, ecrit_reg
     1556         ecrit_hf = ecrit_hf * un_jour
     1557         ecrit_day = ecrit_day * un_jour
     1558         ecrit_mth = ecrit_mth * un_jour
     1559         ecrit_reg = ecrit_reg * un_jour
     1560cIM 030306 END
    15121561c
    15131562c Initialiser le couplage si necessaire
    … …  
    15481597c#include "ini_bilKP_ins.h"
    15491598c#include "ini_bilKP_ave.h"
    1550 #include "ini_histday_seri.h"
    15511599#endif
    15521600
    … …  
    15631611#endif
    15641612
     1613#undef histmthNMC
     1614#define histmthNMC
    15651615#ifdef histmthNMC
    15661616#include "ini_histmthNMC.h"
    15671617#endif
    15681618
    1569 #ifdef histREGDYN
    1570 #include "ini_histREGDYN.h"
    1571 #endif
    1572 
    1573 c#undef histmthNMC
    1574 c#define histmthNMC
    1575 #ifdef histmthNMC
    1576 #include "ini_histmthNMC.h"
    1577 #endif
     1619#include "ini_histday_seri.h"
     1620
     1621#include "ini_paramLMDZ_phy.h"
    15781622
    15791623#endif
    … …  
    16841728        ENDDO
    16851729      ENDDO
    1686 C
    1687       IF (if_ebil.ge.1) THEN
     1730cIM
     1731      IF (ip_ebil_phy.ge.1) THEN
    16881732        ztit='after dynamic'
    1689         CALL diagetpq(airephy,ztit,ip_ebil,1,1,dtime
     1733        CALL diagetpq(airephy,ztit,ip_ebil_phy,1,1,dtime
    16901734     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    16911735     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    … …  
    16941738C     est egale a la variation de la physique au pas de temps precedent.
    16951739C     Donc la somme de ces 2 variations devrait etre nulle.
    1696         call diagphy(airephy,ztit,ip_ebil
     1740        call diagphy(airephy,ztit,ip_ebil_phy
    16971741     e      , zero_v, zero_v, zero_v, zero_v, zero_v
    16981742     e      , zero_v, zero_v, zero_v, ztsol
    … …  
    17301774c Verifier les temperatures
    17311775c
     1776cIM BEG
     1777      IF (check) THEN
     1778       amn=MIN(ftsol(1,is_ter),1000.)
     1779       amx=MAX(ftsol(1,is_ter),-1000.)
     1780       DO i=2, klon
     1781        amn=MIN(ftsol(i,is_ter),amn)
     1782        amx=MAX(ftsol(i,is_ter),amx)
     1783       ENDDO
     1784c
     1785       PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx
     1786      ENDIF !(check) THEN
     1787cIM END
     1788c
    17321789      CALL hgardfou(t_seri,ftsol,'debutphy')
     1790c
     1791cIM BEG
     1792      IF (check) THEN
     1793       amn=MIN(ftsol(1,is_ter),1000.)
     1794       amx=MAX(ftsol(1,is_ter),-1000.)
     1795       DO i=2, klon
     1796        amn=MIN(ftsol(i,is_ter),amn)
     1797        amx=MAX(ftsol(i,is_ter),amx)
     1798       ENDDO
     1799c
     1800       PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx
     1801      ENDIF !(check) THEN
     1802cIM END
    17331803c
    17341804c Incrementer le compteur de la physique
    … …  
    17641834      ENDDO
    17651835      ENDDO
    1766 c
    1767       IF (if_ebil.ge.2) THEN
     1836cIM
     1837      IF (ip_ebil_phy.ge.2) THEN
    17681838        ztit='after reevap'
    1769         CALL diagetpq(airephy,ztit,ip_ebil,2,1,dtime
     1839        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,1,dtime
    17701840     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    17711841     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    1772          call diagphy(airephy,ztit,ip_ebil
     1842         call diagphy(airephy,ztit,ip_ebil_phy
    17731843     e      , zero_v, zero_v, zero_v, zero_v, zero_v
    17741844     e      , zero_v, zero_v, zero_v, ztsol
    … …  
    18391909      fder = dlw
    18401910
     1911      IF (check) THEN
     1912       amn=MIN(tslab(1),1000.)
     1913       amx=MAX(tslab(1),-1000.)
     1914       DO i=2, klon
     1915        amn=MIN(tslab(i),amn)
     1916        amx=MAX(tslab(i),amx)
     1917       ENDDO
     1918c
     1919       PRINT*,' debut avant clqh min max tslab',amn,amx
     1920      ENDIF !(check) THEN
     1921c
    18411922      CALL clmain(dtime,itap,date0,pctsrf,pctsrf_new,
    18421923     e            t_seri,q_seri,u_seri,v_seri,
    … …  
    18571938     s            dsens, devap,
    18581939     s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m,
    1859 cIM cf. AM 081204 BEG
    18601940     s            pblh,capCL,oliqCL,cteiCL,pblT,
    18611941     s            therm,trmb1,trmb2,trmb3,plcl,
    1862 cIM cf. AM 081204 END
    18631942     s            fqcalving, ffonte, run_off_lic_0,
    18641943cIM "slab" ocean
    … …  
    19031982      ENDDO
    19041983      ENDDO
    1905 c
    1906       IF (if_ebil.ge.2) THEN
     1984cIM
     1985      IF (ip_ebil_phy.ge.2) THEN
    19071986        ztit='after clmain'
    1908         CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
     1987        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    19091988     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    19101989     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    1911          call diagphy(airephy,ztit,ip_ebil
     1990         call diagphy(airephy,ztit,ip_ebil_phy
    19121991     e      , zero_v, zero_v, zero_v, zero_v, sens
    19131992     e      , evap  , zero_v, zero_v, ztsol
    … …  
    19572036            wfbils(i,nsrf) = ( fsolsw(i,nsrf) + fsollw(i,nsrf)
    19582037     $         + fluxt(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
     2038cIM
     2039            wfbilo(i,nsrf) = ( fevap(i,nsrf) -
     2040     $      (rain_fall(i) + snow_fall(i)) ) * pctsrf(i,nsrf)
    19592041            zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
    19602042            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf)*pctsrf(i,nsrf)
    … …  
    19832065      ENDDO
    19842066
     2067      IF (check) THEN
     2068       amn=MIN(ftsol(1,is_ter),1000.)
     2069       amx=MAX(ftsol(1,is_ter),-1000.)
     2070       DO i=2, klon
     2071        amn=MIN(ftsol(i,is_ter),amn)
     2072        amx=MAX(ftsol(i,is_ter),amx)
     2073       ENDDO
     2074c
     2075       PRINT*,' debut apres d_ts min max ftsol',itap,amn,amx
     2076      ENDIF !(check) THEN
    19852077c
    19862078c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
    … …  
    19882080      DO nsrf = 1, nbsrf
    19892081        DO i = 1, klon
    1990           IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
    1991 cccIM
    1992           IF (pctsrf(i,nsrf) .LT. epsfra) t2m(i,nsrf) = zt2m(i)
    1993           IF (pctsrf(i,nsrf) .LT. epsfra) q2m(i,nsrf) = zq2m(i)
    1994           IF (pctsrf(i,nsrf) .LT. epsfra) u10m(i,nsrf) = zu10m(i)
    1995           IF (pctsrf(i,nsrf) .LT. epsfra) v10m(i,nsrf) = zv10m(i)
    1996 cIM cf JLD ??
    1997           IF (pctsrf(i,nsrf) .LT. epsfra) ffonte(i,nsrf) = zxffonte(i)
    1998           IF (pctsrf(i,nsrf) .LT. epsfra)
    1999      .    fqcalving(i,nsrf) = zxfqcalving(i)
    2000 cIM cf. AM 081204 BEG
    2001           IF (pctsrf(i,nsrf) .LT. epsfra) pblh(i,nsrf)=s_pblh(i)
    2002           IF (pctsrf(i,nsrf) .LT. epsfra) plcl(i,nsrf)=s_lcl(i)
    2003           IF (pctsrf(i,nsrf) .LT. epsfra) capCL(i,nsrf)=s_capCL(i)
    2004           IF (pctsrf(i,nsrf) .LT. epsfra) oliqCL(i,nsrf)=s_oliqCL(i)
    2005           IF (pctsrf(i,nsrf) .LT. epsfra) cteiCL(i,nsrf)=s_cteiCL(i)
    2006           IF (pctsrf(i,nsrf) .LT. epsfra) pblT(i,nsrf)=s_pblT(i)
    2007           IF (pctsrf(i,nsrf) .LT. epsfra) therm(i,nsrf)=s_therm(i)
    2008           IF (pctsrf(i,nsrf) .LT. epsfra) trmb1(i,nsrf)=s_trmb1(i)
    2009           IF (pctsrf(i,nsrf) .LT. epsfra) trmb2(i,nsrf)=s_trmb2(i)
    2010           IF (pctsrf(i,nsrf) .LT. epsfra) trmb3(i,nsrf)=s_trmb3(i)
     2082          IF (pctsrf(i,nsrf) .LT. epsfra.OR.t2m(i,nsrf).EQ.0.) THEN
     2083           ftsol(i,nsrf) = zxtsol(i)
     2084           t2m(i,nsrf) = zt2m(i)
     2085           q2m(i,nsrf) = zq2m(i)
     2086           u10m(i,nsrf) = zu10m(i)
     2087           v10m(i,nsrf) = zv10m(i)
     2088           ffonte(i,nsrf) = zxffonte(i)
     2089           fqcalving(i,nsrf) = zxfqcalving(i)
     2090           pblh(i,nsrf)=s_pblh(i)
     2091           plcl(i,nsrf)=s_lcl(i)
     2092           capCL(i,nsrf)=s_capCL(i)
     2093           oliqCL(i,nsrf)=s_oliqCL(i)
     2094           cteiCL(i,nsrf)=s_cteiCL(i)
     2095           pblT(i,nsrf)=s_pblT(i)
     2096           therm(i,nsrf)=s_therm(i)
     2097           trmb1(i,nsrf)=s_trmb1(i)
     2098           trmb2(i,nsrf)=s_trmb2(i)
     2099           trmb3(i,nsrf)=s_trmb3(i)
     2100          ENDIF
    20112101        ENDDO
    20122102      ENDDO
    2013 c
    20142103c
    20152104c Calculer la derive du flux infrarouge
    … …  
    21742263        ENDDO
    21752264      ENDDO
    2176 c
    2177       IF (if_ebil.ge.2) THEN
     2265cIM
     2266      IF (ip_ebil_phy.ge.2) THEN
    21782267        ztit='after convect'
    2179         CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
     2268        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    21802269     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    21812270     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2182          call diagphy(airephy,ztit,ip_ebil
     2271         call diagphy(airephy,ztit,ip_ebil_phy
    21832272     e      , zero_v, zero_v, zero_v, zero_v, zero_v
    21842273     e      , zero_v, rain_con, snow_con, ztsol
    … …  
    22642353c
    22652354c===================================================================
    2266 c
    2267       IF (if_ebil.ge.2) THEN
     2355cIM
     2356      IF (ip_ebil_phy.ge.2) THEN
    22682357        ztit='after dry_adjust'
    2269         CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
     2358        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    22702359     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    22712360     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    … …  
    23622451         WRITE(lunout,*)"Precip=", zx_t
    23632452      ENDIF
    2364 c
    2365       IF (if_ebil.ge.2) THEN
     2453cIM
     2454      IF (ip_ebil_phy.ge.2) THEN
    23662455        ztit='after fisrt'
    2367         CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
     2456        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    23682457     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    23692458     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2370         call diagphy(airephy,ztit,ip_ebil
     2459        call diagphy(airephy,ztit,ip_ebil_phy
    23712460     e      , zero_v, zero_v, zero_v, zero_v, zero_v
    23722461     e      , zero_v, rain_lsc, snow_lsc, ztsol
    … …  
    24712560         snow_fall(i) = snow_con(i) + snow_lsc(i)
    24722561      ENDDO
    2473 c
    2474       IF (if_ebil.ge.2) THEN
     2562cIM
     2563      IF (ip_ebil_phy.ge.2) THEN
    24752564        ztit="after diagcld"
    2476         CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
     2565        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    24772566     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    24782567     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    … …  
    25012590      ENDDO
    25022591      ENDDO
     2592c
     2593cIM Calculer l'humidite relative a 2m (rh2m) pour diagnostique
     2594cIM ajout dependance type surface
     2595      DO i = 1, klon
     2596       rh2m(i)=0.
     2597       qsat2m(i)=0.
     2598      DO nsrf=1, nbsrf
     2599         zx_t1(i,nsrf) = t2m(i,nsrf)
     2600         IF (thermcep) THEN
     2601            zdelta1(i,nsrf) = MAX(0.,SIGN(1.,rtt-zx_t1(i,nsrf)))
     2602            zx_qs1(i,nsrf)  = r2es *
     2603     $      FOEEW(zx_t1(i,nsrf),zdelta1(i,nsrf))/paprs(i,1)
     2604            zx_qs1(i,nsrf)  = MIN(0.5,zx_qs1(i,nsrf))
     2605            zcor1(i,nsrf)   = 1./(1.-retv*zx_qs1(i,nsrf))
     2606            zx_qs1(i,nsrf)  = zx_qs1(i,nsrf)*zcor1(i,nsrf)
     2607         ELSE
     2608c
     2609           IF (zx_t.LT.RTT) THEN
     2610              zx_qs = qsats(zx_t)/paprs(i,1)
     2611           ELSE
     2612              zx_qs = qsatl(zx_t)/paprs(i,1)
     2613           ENDIF
     2614         ENDIF
     2615       zx_rh2m(i,nsrf) = q2m(i,nsrf)/zx_qs1(i,nsrf)
     2616       zx_qsat2m(i,nsrf)=zx_qs1(i,nsrf)
     2617       rh2m(i) = rh2m(i)+zx_rh2m(i,nsrf)*pctsrf(i,nsrf)
     2618       qsat2m(i)=qsat2m(i)+zx_qsat2m(i,nsrf)*pctsrf(i,nsrf)
     2619      ENDDO !nsrf
     2620      ENDDO
     2621c
     2622cIM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
     2623c   equivalente a 2m (tpote) pour diagnostique
     2624c
     2625      DO i = 1, klon
     2626       tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA
     2627       IF (thermcep) THEN
     2628        IF(zt2m(i).LT.RTT) then
     2629         Lheat=RLSTT
     2630        ELSE
     2631         Lheat=RLVTT
     2632        ENDIF
     2633       ELSE
     2634        IF (zt2m(i).LT.RTT) THEN
     2635         Lheat=RLSTT
     2636        ELSE
     2637         Lheat=RLVTT
     2638        ENDIF
     2639       ENDIF
     2640       tpote(i) = tpot(i)*     
     2641     . EXP((Lheat *qsat2m(i))/(RCPD*zt2m(i)))
     2642      ENDDO
     2643c
    25032644cjq - introduce the aerosol direct and first indirect radiative forcings
    25042645cjq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
    … …  
    26432784      ENDDO
    26442785      ENDDO
    2645 c
    2646       IF (if_ebil.ge.2) THEN
     2786cIM
     2787      IF (ip_ebil_phy.ge.2) THEN
    26472788        ztit='after rad'
    2648         CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
     2789        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    26492790     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    26502791     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2651         call diagphy(airephy,ztit,ip_ebil
     2792        call diagphy(airephy,ztit,ip_ebil_phy
    26522793     e      , topsw, toplw, solsw, sollw, zero_v
    26532794     e      , zero_v, zero_v, zero_v, ztsol
    … …  
    27882929     C               aam, torsfc)
    27892930cIM cf. FLott END
    2790 c
    2791       IF (if_ebil.ge.2) THEN
     2931cIM
     2932      IF (ip_ebil_phy.ge.2) THEN
    27922933        ztit='after orography'
    2793         CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
     2934        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    27942935     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    27952936     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    … …  
    28833024     s                   ve, vq, ue, uq)
    28843025c
    2885 cIM diag. bilKP
     3026cIM global posePB BEG
     3027      IF(1.EQ.0) THEN
    28863028c
    28873029      CALL transp_lay (paprs,zxtsol,
    … …  
    28893031     s                   ve_lay, vq_lay, ue_lay, uq_lay)
    28903032c
     3033      ENDIF !(1.EQ.0) THEN
     3034cIM global posePB END
    28913035c Accumuler les variables a stocker dans les fichiers histoire:
    28923036c
    … …  
    29023046      END DO
    29033047c-jld ec_conser
    2904       IF (if_ebil.ge.1) THEN
     3048cIM
     3049      IF (ip_ebil_phy.ge.1) THEN
    29053050        ztit='after physic'
    2906         CALL diagetpq(airephy,ztit,ip_ebil,1,1,dtime
     3051        CALL diagetpq(airephy,ztit,ip_ebil_phy,1,1,dtime
    29073052     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    29083053     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    … …  
    29113056C     est egale a la variation de la physique au pas de temps precedent.
    29123057C     Donc la somme de ces 2 variations devrait etre nulle.
    2913         call diagphy(airephy,ztit,ip_ebil
     3058        call diagphy(airephy,ztit,ip_ebil_phy
    29143059     e      , topsw, toplw, solsw, sollw, sens
    29153060     e      , evap, rain_fall, snow_fall, ztsol
    … …  
    30013146c
    30023147cIM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
    3003 c#include "write_bilKP_ins.h"
    3004 c#include "write_bilKP_ave.h"
     3148cIM global posePB#include "write_bilKP_ins.h"
     3149cIM global posePB#include "write_bilKP_ave.h"
    30053150c
    30063151c Sauvegarder les valeurs de t et q a la fin de la physique:
    … …  
    30253170#ifdef histday
    30263171#include "write_histday.h"
    3027 #include "write_histday_seri.h"
    30283172#endif
    30293173
    … …  
    30363180#endif
    30373181
    3038 #ifdef histREGDYN
    3039 #include "write_histREGDYN.h"
    3040 #endif
    3041 
    30423182#ifdef histISCCP
    30433183#include "write_histISCCP.h"
    30443184#endif
    30453185
    3046 
    30473186#ifdef histmthNMC
    30483187#include "write_histmthNMC.h"
    30493188#endif
     3189
     3190#include "write_histday_seri.h"
     3191
     3192#include "write_paramLMDZ_phy.h"
    30503193
    30513194#endif
    … …  
    30663209     .      fqsurf, qsol,
    30673210     .      fsnow, falbe,falblw, fevap, rain_fall, snow_fall,
    3068      .      solsw, sollwdown,dlw,
     3211cIM  .      solsw, sollwdown,dlw,
     3212     .      solsw, sollw,dlw,
    30693213     .      radsol,frugs,agesno,
    30703214     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
Note: See TracChangeset for help on using the changeset viewer.