Ignore:
Timestamp:
May 25, 2005, 3:10:09 PM (19 years ago)
Author:
Laurent Fairhead
Message:

Synchronisation avec tous les diagnostiques de Ionela IM
Inclusion du slab ocean IM
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r625 r644  
    1111     .            flxmass_w,
    1212#endif
    13      .            d_u, d_v, d_t, d_qx, d_ps)
     13     .            d_u, d_v, d_t, d_qx, d_ps
     14cIM Amip2
     15     .            , dudyn
     16     .            , PVteta)
    1417
    1518      USE ioipsl
    … …  
    4043#define histins
    4144c#define histISCCP
    42 #define histREGDYN
    43 #define histmthNMC
     45c#define histREGDYN
     46c#define histmthNMC
    4447c======================================================================
    4548c    modif   ( P. Le Van ,  12/10/98 )
    … …  
    7376c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
    7477c d_ps----output-R-tendance physique de la pression au sol
     78cIM
     79c PVteta--output-R-vorticite potentielle a des thetas constantes
    7580c======================================================================
    7681#include "dimensions.h"
    … …  
    116121c     parameter (ocean = 'couple')
    117122      logical ok_ocean
     123      SAVE ok_ocean
     124c
     125cIM "slab" ocean
     126      REAL tslab(klon)    !Temperature du slab-ocean
     127      REAL seaice(klon)   !glace de mer (kg/m2)
     128      REAL fluxo(klon)    !flux turbulents ocean-glace de mer
     129      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
     130c
    118131c======================================================================
    119132c Clef controlant l'activation du cycle diurne:
    … …  
    188201      REAL znivsig(klev)
    189202      REAL zsurf(nbsrf)
    190 
     203cIM
     204      INTEGER kinv
     205      real pir
     206cMI
    191207      REAL u(klon,klev)
    192208      REAL v(klon,klev)
    … …  
    213229      REAL d_ps(klon)
    214230      real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
     231c
     232cIM Amip2 PV a theta constante
     233c
     234      INTEGER nbteta
     235      PARAMETER(nbteta=3)
     236      CHARACTER*3 ctetaSTD(nbteta)
     237      DATA ctetaSTD/'350','380','405'/
     238      REAL rtetaSTD(nbteta)
     239      DATA rtetaSTD/350., 380., 405./
     240c
     241      REAL PVteta(klon,nbteta)
     242      REAL zx_tmp_3dte(iim,jjmp1,nbteta)
     243c
     244cMI Amip2 PV a theta constante
    215245
    216246      INTEGER klevp1, klevm1
    … …  
    238268      SAVE LWdnTOA, LWdnTOAclr
    239269c
    240 c vents meridien et zonal a un niveau de pression
     270cIM Amip2
     271c variables a une pression donnee
    241272c
    242273      integer nlevSTD
    … …  
    246277     .60000., 50000., 40000., 30000., 25000., 20000.,
    247278     .15000., 10000., 7000., 5000., 3000., 2000., 1000./
    248       CHARACTER*5 clevSTD(nlevSTD), aa, bb
     279      CHARACTER*4 clevSTD(nlevSTD)
    249280      DATA clevSTD/'1000','925 ','850 ','700 ','600 ',
    250281     .'500 ','400 ','300 ','250 ','200 ','150 ','100 ',
    251282     .'70  ','50  ','30  ','20  ','10  '/
    252283c
     284      CHARACTER*3 bb2
     285      CHARACTER*2 bb3
     286c
    253287      real tlevSTD(klon,nlevSTD), qlevSTD(klon,nlevSTD)
    254288      real rhlevSTD(klon,nlevSTD), philevSTD(klon,nlevSTD)
    255289      real ulevSTD(klon,nlevSTD), vlevSTD(klon,nlevSTD)
    256 c
    257 cIM ENSEMBLES BEG
    258 c
    259       integer nlevENS
    260       PARAMETER(nlevENS=4)
    261       integer indENS(nlevENS)
    262       save indENS
    263       real rlevENS(nlevENS)
    264       DATA rlevENS/85000., 70000., 50000., 20000./
    265       CHARACTER*3 clev(nlevENS)
    266       DATA clev/'850','700','500','200'/
    267  
    268       real tlev(klon,nlevENS), qlev(klon,nlevENS), rhlev(klon,nlevENS)
    269       real ulev(klon,nlevENS), vlev(klon,nlevENS), philev(klon,nlevENS)
    270       real wlev(klon,nlevENS)
    271 cIM ENSEMBLES END
     290      real wlevSTD(klon,nlevSTD)
     291c
     292c nout : niveau de output des variables a une pression donnee
     293      INTEGER nout
     294      PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC
     295c
     296      REAL tsumSTD(klon,nlevSTD,nout)
     297      REAL usumSTD(klon,nlevSTD,nout), vsumSTD(klon,nlevSTD,nout)
     298      REAL wsumSTD(klon,nlevSTD,nout), phisumSTD(klon,nlevSTD,nout)
     299      REAL qsumSTD(klon,nlevSTD,nout), rhsumSTD(klon,nlevSTD,nout)
     300c
     301      SAVE tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD,
     302     .     qsumSTD, rhsumSTD
     303c
     304      logical oknondef(klon,nlevSTD,nout)
     305      real tnondef(klon,nlevSTD,nout)
     306      save tnondef
     307c
     308c les produits uvSTD, vqSTD, .., T2STD sont calcules
     309c a partir des valeurs instantannees toutes les 6 h
     310c qui sont moyennees sur le mois
     311c
     312      real uvSTD(klon,nlevSTD)
     313      real vqSTD(klon,nlevSTD)
     314      real vTSTD(klon,nlevSTD)
     315      real wqSTD(klon,nlevSTD)
     316c
     317      real uvsumSTD(klon,nlevSTD,nout)
     318      real vqsumSTD(klon,nlevSTD,nout)
     319      real vTsumSTD(klon,nlevSTD,nout)
     320      real wqsumSTD(klon,nlevSTD,nout)
     321c
     322      real vphiSTD(klon,nlevSTD)
     323      real wTSTD(klon,nlevSTD)
     324      real u2STD(klon,nlevSTD)
     325      real v2STD(klon,nlevSTD)
     326      real T2STD(klon,nlevSTD)
     327c
     328      real vphisumSTD(klon,nlevSTD,nout)
     329      real wTsumSTD(klon,nlevSTD,nout)
     330      real u2sumSTD(klon,nlevSTD,nout)
     331      real v2sumSTD(klon,nlevSTD,nout)
     332      real T2sumSTD(klon,nlevSTD,nout)
     333c
     334      SAVE uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD
     335      SAVE vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD
     336cMI Amip2
     337c
     338#include "radepsi.h"
     339#include "radopt.h"
     340c
    272341c
    273342c prw: precipitable water
    … …  
    282351      REAL cldt_s(klon),cldq_s(klon) !nuage total, eau liquide integree
    283352
    284       INTEGER linv, kp1
     353      INTEGER kp1
    285354c flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)
    286355c flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
    … …  
    292361      REAL flwc_s(klon,klev), fiwc_s(klon,klev)
    293362
    294 c ISCCP simulator v3.4
     363cIM ISCCP simulator v3.4
    295364c dans clesphys.h top_height, overlap
    296365cv3.4
    … …  
    322391      REAL emsfc_lw
    323392      PARAMETER(emsfc_lw=0.99)
    324       REAL    ran0                      ! type for random number fuction
     393c     REAL    ran0                      ! type for random number fuction
    325394c
    326395      REAL cldtot(klon,klev)
    … …  
    351420      REAL boxptop(klon,ncol)
    352421c
    353       INTEGER l, ni, nj, kmax, lmax
     422      INTEGER l, kmax, lmax
    354423      PARAMETER(kmax=8, lmax=8)
    355424      INTEGER kmaxm1, lmaxm1
    … …  
    358427      PARAMETER(iimx7=iim*kmaxm1, jjmx7=jjm*lmaxm1,
    359428     .jjmp1x7=jjmp1*lmaxm1)
    360       REAL fq4d(iim,jjmp1,kmaxm1,lmaxm1)
    361       REAL fq3d(iimx7, jjmp1x7)
    362429c
    363430      INTEGER iw, iwmax
    … …  
    376443      SAVE nhistoWt
    377444
     445      INTEGER linv
    378446      INTEGER pct_ocean(klon,nbregdyn)
    379       REAL rlonPOS(klon)
    380447 
    381448c sorties ISCCP
    382449
    383       logical ok_isccp
    384       real ecrit_isccp
     450c     logical ok_isccp
     451c     real ecrit_isccp
    385452      integer nid_isccp
    386       save ok_isccp, ecrit_isccp, nid_isccp       
    387 
    388 #ifdef histISCCP
    389       data ok_isccp/.true./     
    390 #else
    391       data ok_isccp/.false./
    392 #endif
     453c     save ok_isccp, ecrit_isccp, nid_isccp       
     454      save nid_isccp       
     455cIM 090704 BEG
     456      INTEGER nbapp_isccp,isccppas
     457
     458#undef histISCCP
     459#define histISCCP
     460c     data ok_isccp,ecrit_isccp/.true.,0.125/     
     461c     data ok_isccp,ecrit_isccp/.true.,1./     
     462cIM 190504     data ok_isccp/.true./     
     463cIM 190504 #else
     464cIM 190504     data ok_isccp/.false./
     465cIM 190504 #endif
    393466
    394467c sorties statistiques regime dynamique
    395       logical ok_regdyn
    396       real ecrit_regdyn
     468c     logical ok_regdyn
     469c     real ecrit_regdyn
    397470      integer nid_regdyn
    398       save ok_regdyn, ecrit_regdyn, nid_regdyn
    399 
    400 #ifdef histREGDYN
     471c     save ok_regdyn, ecrit_regdyn, nid_regdyn
     472      save nid_regdyn
     473
     474#undef histREGDYN
     475#define histREGDYN
     476cIM 190504 #ifdef histREGDYN
    401477c     data ok_regdyn,ecrit_regdyn/.true.,0.125/
    402478c     data ok_regdyn,ecrit_regdyn/.true.,1./
    403        data ok_regdyn/.true./
    404 #else
    405       data ok_regdyn/.false./
    406 #endif
     479cIM 190504    data ok_regdyn/.true./
     480cIM 190504 #else
     481cIM 190504   data ok_regdyn/.false./
     482cIM 190504 #endif
    407483
    408484      REAL zx_tau(kmaxm1), zx_pc(lmaxm1), zx_o500(iwmax)
    … …  
    418494c taulev: numero du niveau de tau dans les sorties ISCCP
    419495      CHARACTER *4 taulev(kmaxm1)
    420       DATA taulev/'tau1','tau2','tau3','tau4','tau5','tau6','tau7'/
    421 
    422       REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7)
    423       INTEGER nhorix7
     496c     DATA taulev/'tau1','tau2','tau3','tau4','tau5','tau6','tau7'/
     497      DATA taulev/'tau0','tau1','tau2','tau3','tau4','tau5','tau6'/
     498      CHARACTER *3 pclev(lmaxm1)
     499      DATA pclev/'pc1','pc2','pc3','pc4','pc5','pc6','pc7'/
     500c
     501c cnameisccp
     502      CHARACTER *27 cnameisccp(lmaxm1,kmaxm1)
     503      DATA cnameisccp/'pc< 50hPa, tau< 0.3',
     504     .                'pc= 50-180hPa, tau< 0.3',
     505     .                'pc= 180-310hPa, tau< 0.3',
     506     .                'pc= 310-440hPa, tau< 0.3',
     507     .                'pc= 440-560hPa, tau< 0.3',
     508     .                'pc= 560-680hPa, tau< 0.3',
     509     .                'pc= 680-800hPa, tau< 0.3',
     510     .                'pc< 50hPa, tau= 0.3-1.3',
     511     .                'pc= 50-180hPa, tau= 0.3-1.3',
     512     .                'pc= 180-310hPa, tau= 0.3-1.3',
     513     .                'pc= 310-440hPa, tau= 0.3-1.3',
     514     .                'pc= 440-560hPa, tau= 0.3-1.3',
     515     .                'pc= 560-680hPa, tau= 0.3-1.3',
     516     .                'pc= 680-800hPa, tau= 0.3-1.3',
     517     .                'pc< 50hPa, tau= 1.3-3.6',
     518     .                'pc= 50-180hPa, tau= 1.3-3.6',
     519     .                'pc= 180-310hPa, tau= 1.3-3.6',
     520     .                'pc= 310-440hPa, tau= 1.3-3.6',
     521     .                'pc= 440-560hPa, tau= 1.3-3.6',
     522     .                'pc= 560-680hPa, tau= 1.3-3.6',
     523     .                'pc= 680-800hPa, tau= 1.3-3.6',
     524     .                'pc< 50hPa, tau= 3.6-9.4',
     525     .                'pc= 50-180hPa, tau= 3.6-9.4',
     526     .                'pc= 180-310hPa, tau= 3.6-9.4',
     527     .                'pc= 310-440hPa, tau= 3.6-9.4',
     528     .                'pc= 440-560hPa, tau= 3.6-9.4',
     529     .                'pc= 560-680hPa, tau= 3.6-9.4',
     530     .                'pc= 680-800hPa, tau= 3.6-9.4',
     531     .                'pc< 50hPa, tau= 9.4-23',
     532     .                'pc= 50-180hPa, tau= 9.4-23',
     533     .                'pc= 180-310hPa, tau= 9.4-23',
     534     .                'pc= 310-440hPa, tau= 9.4-23',
     535     .                'pc= 440-560hPa, tau= 9.4-23',
     536     .                'pc= 560-680hPa, tau= 9.4-23',
     537     .                'pc= 680-800hPa, tau= 9.4-23',
     538     .                'pc< 50hPa, tau= 23-60',
     539     .                'pc= 50-180hPa, tau= 23-60',
     540     .                'pc= 180-310hPa, tau= 23-60',
     541     .                'pc= 310-440hPa, tau= 23-60',
     542     .                'pc= 440-560hPa, tau= 23-60',
     543     .                'pc= 560-680hPa, tau= 23-60',
     544     .                'pc= 680-800hPa, tau= 23-60',
     545     .                'pc< 50hPa, tau> 60.',
     546     .                'pc= 50-180hPa, tau> 60.',
     547     .                'pc= 180-310hPa, tau> 60.',
     548     .                'pc= 310-440hPa, tau> 60.',
     549     .                'pc= 440-560hPa, tau> 60.',
     550     .                'pc= 560-680hPa, tau> 60.',
     551     .                'pc= 680-800hPa, tau> 60.'/
     552c
     553c     REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7)
     554c     INTEGER nhorix7
    424555cIM: region='3d' <==> sorties en global
    425556      CHARACTER*3 region
    426557      PARAMETER(region='3d')
    427558c
     559cIM ISCCP simulator v3.4
     560c
    428561      logical ok_hf
    429       real ecrit_hf
     562cIM200505     integer ecrit_hf
     563cIM200505    integer ecrit_hf2mth
     564cIM200505    save ecrit_hf2mth
     565c
    430566      integer nid_hf, nid_hf3d
    431       save ok_hf, ecrit_hf, nid_hf, nid_hf3d
     567cIM200505     save ok_hf, ecrit_hf, nid_hf, nid_hf3d
     568      save ok_hf, nid_hf, nid_hf3d
    432569
    433570c  QUESTION : noms de variables ?
    434571
    435572#ifdef histhf
    436       data ok_hf,ecrit_hf/.true.,0.25/
     573cIM 130904   data ok_hf,ecrit_hf/.true.,0.25/
     574      data ok_hf/.true./
    437575#else
    438576      data ok_hf/.false./
    … …  
    465603      REAL rlon(klon)
    466604      SAVE rlon                   ! longitude pour chaque point
     605c
     606      REAL rlonPOS(klon)
     607      SAVE rlonPOS                ! longitudes > 0. pour chaque point
    467608c
    468609cc      INTEGER iflag_con
    … …  
    534675      SAVE rugoro                 ! longueur de rugosite de l'OESM
    535676c
    536       REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
     677cIM 141004     REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
     678      REAL zulow(klon),zvlow(klon)
    537679c
    538680      REAL zuthe(klon),zvthe(klon)
    … …  
    621763      REAL snow_fall(klon) ! neige
    622764      save snow_fall, rain_fall
    623 cIM 050204 BEG
     765cIM cf FH pour Tiedtke 080604
     766      REAL rain_tiedtke(klon),snow_tiedtke(klon)
     767c
    624768      REAL total_rain(klon), nday_rain(klon)
    625       save total_rain, nday_rain
    626 cIM 050204 END
     769      save nday_rain
     770c
    627771      REAL evap(klon), devap(klon) ! evaporation et sa derivee
    628772      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
    … …  
    655799      REAL pctsrf_new(klon,nbsrf) !pourcentage surfaces issus d'ORCHIDEE
    656800      REAL paire_ter(klon)        !surfaces terre
    657 cIM
     801c
    658802      SAVE pctsrf                 ! sous-fraction du sol
    659803      REAL albsol(klon)
    … …  
    699843      EXTERNAL lnblnk1   !enleve les blancs a la fin d'une variable de type
    700844                         !caracter
     845      EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
     846      EXTERNAL undefSTD      !somme les valeurs definies d'1 var a 1 niveau de pression
     847c     EXTERNAL moy_undefSTD  !moyenne d'1 var a 1 niveau de pression
     848c     EXTERNAL moyglo_aire   !moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)
     849c                            !par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)
    701850c
    702851c Variables locales
    … …  
    704853      real clwcon(klon,klev),rnebcon(klon,klev)
    705854      real clwcon0(klon,klev),rnebcon0(klon,klev)
     855cIM cf. AM 081204 BEG
     856      real clwcon0th(klon,klev),rnebcon0th(klon,klev)
     857cIM cf. AM 081204 END
    706858      save rnebcon, clwcon
    707859
    … …  
    770922      REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
    771923      real zqsat(klon,klev)
    772       INTEGER i, k, iq, ig, j, iiq, nsrf, ll
     924      INTEGER i, k, iq, ig, j, nsrf, ll
    773925      REAL t_coup
    774926      PARAMETER (t_coup=234.0)
    775927c
    776928      REAL zphi(klon,klev)
    777       REAL zx_tmp_x(iim), zx_tmp_yjjmp1
    778929      REAL zx_relief(iim,jjmp1)
    779930      REAL zx_aire(iim,jjmp1)
     931c
     932cIM cf. AM Variables locales pour la CLA (hbtm2)
     933c
     934      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite
     935      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA
     936      REAL capCL(klon, nbsrf)          ! CAPE de couche limite
     937      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite
     938      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite
     939      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite
     940      REAL therm(klon, nbsrf)
     941      REAL trmb1(klon, nbsrf)          ! deep_cape
     942      REAL trmb2(klon, nbsrf)          ! inhibition
     943      REAL trmb3(klon, nbsrf)          ! Point Omega
     944c Grdeurs de sorties
     945      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
     946      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
     947      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
     948      REAL s_trmb3(klon)
    780949cKE43
    781950c Variables locales pour la convection de K. Emanuel (sb):
    … …  
    796965      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
    797966c -- convect43:
    798       INTEGER ntra              ! nb traceurs
     967      INTEGER ntra              ! nb traceurs pour convect4.3
    799968      REAL pori_con(klon)    ! pressure at the origin level of lifted parcel
    800969      REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
    … …  
    820989      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
    821990      REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
     991      REAL d_t_oli(klon,klev) !tendances dues a oro et lif
    822992      REAL rneb(klon,klev)
     993c
     994*********************************************************
     995*     declarations
     996      real zqasc(klon,klev)
     997      save zqasc
     998     
     999*********************************************************
     1000cIM 081204 END
    8231001c
    8241002      REAL pmfu(klon,klev), pmfd(klon,klev)
    … …  
    8631041
    8641042      logical ptconv(klon,klev)
    865 
     1043cIM cf. AM 081204 BEG
     1044      logical ptconvth(klon,klev)
     1045cIM cf. AM 081204 END
    8661046c
    8671047c Variables liees a l'ecriture de la bande histoire physique
    8681048c
    869       INTEGER ecrit_mth
    870       SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
    871 c
    872       INTEGER ecrit_day
    873       SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
    874 c
    875       INTEGER ecrit_ins
    876       SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
    877 c
    878       INTEGER ecrit_reg
    879       SAVE ecrit_reg   ! frequence d'ecriture
     1049c======================================================================
     1050cIM200505     INTEGER ecrit_mth
     1051cIM200505     SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
     1052c
     1053cIM cf. AM 081204 BEG
     1054c   declarations pour sortir sur une sous-region
     1055      integer imin_ins,imax_ins,jmin_ins,jmax_ins
     1056      save imin_ins,imax_ins,jmin_ins,jmax_ins
     1057c      real lonmin_ins,lonmax_ins,latmin_ins
     1058c     s  ,latmax_ins
     1059c     data lonmin_ins,lonmax_ins,latmin_ins
     1060c    s  ,latmax_ins/
     1061c valeurs initiales     s   -5.,20.,41.,55./   
     1062c    s   100.,130.,-20.,20./
     1063c    s   -180.,180.,-90.,90./
     1064c======================================================================
     1065cIM cf. AM 081204 END
     1066
     1067c
     1068cIM200505     INTEGER ecrit_day
     1069cIM200505     SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
     1070c
     1071cIM200505     INTEGER ecrit_ins
     1072cIM200505     SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
     1073c
     1074cIM200505     INTEGER ecrit_reg
     1075cIM200505     SAVE ecrit_reg   ! frequence d'ecriture
    8801076c
    8811077      integer itau_w   ! pas de temps ecriture = itap + itau_phy
    … …  
    8981094c
    8991095      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
     1096c
     1097cIM AMIP2 BEG
     1098      REAL moyglo, mountor
     1099cIM 141004 BEG
     1100      REAL zustrdr(klon), zvstrdr(klon)
     1101      REAL zustrli(klon), zvstrli(klon)
     1102      REAL zustrph(klon), zvstrph(klon)
     1103      REAL aam, torsfc
     1104cIM 141004 END
     1105cIM 190504 BEG
     1106      INTEGER ij, imp1jmp1
     1107      PARAMETER(imp1jmp1=(iim+1)*jjmp1)
     1108      REAL zx_tmp(imp1jmp1), airedyn(iim+1,jjmp1)
     1109      REAL padyn(iim+1,jjmp1,klev+1)
     1110      REAL dudyn(iim+1,jjmp1,klev)
     1111      REAL rlatdyn(iim+1,jjmp1)
     1112cIM 190504 END
     1113      LOGICAL ok_msk
     1114      REAL msk(klon)
     1115cIM
     1116      REAL airetot, pi
     1117      REAL zm_wo(jjmp1, klev)
     1118cIM AMIP2 END
     1119c
    9001120      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
    9011121      REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
     1122      REAL*8 zx_tmp2_fi3d(klon,klev) ! variable temporaire pour champs 3D
    9021123      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
    9031124      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
    9041125c
    905       INTEGER nid_day, nid_mth, nid_ins, nid_nmc
    906       SAVE nid_day, nid_mth, nid_ins, nid_nmc
    907 c
    908       INTEGER nhori, nvert
     1126      INTEGER nid_day, nid_mth, nid_ins, nid_nmc, nid_day_seri
     1127      SAVE nid_day, nid_mth, nid_ins, nid_nmc, nid_day_seri
     1128c
     1129cIM 280405 BEG
     1130      INTEGER nid_bilKPins, nid_bilKPave
     1131      SAVE nid_bilKPins, nid_bilKPave
     1132c
     1133      REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
     1134      REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert.
     1135      REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert.
     1136      REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert.
     1137c
     1138cIM 280405 END
     1139c
     1140      INTEGER nhori, nvert, nvert1
     1141c     REAL zstok
    9091142      REAL zsto, zout, zsto1, zsto2
     1143c     REAL zstoave, zstoin
     1144      REAL zstophy, zstorad, zstohf, zstoday, zstomth
    9101145      real zjulian
    9111146      save zjulian
    … …  
    9541189      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille
    9551190      CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
     1191      CHARACTER*40 tinst, tave, typeval
    9561192cjq   Aerosol effects (Johannes Quaas, 27/11/2003)
    9571193      REAL sulfate(klon, klev) ! SO4 aerosol concentration [ug/m3]
    … …  
    10411277      IF (debut) THEN
    10421278         CALL suphec ! initialiser constantes et parametres phys.
    1043 c
    1044 cIM 050204 BEG
    1045          DO i=1, klon
    1046           nday_rain(i)=0.
    1047          ENDDO
    1048 cIM 050204 END
    1049 c
     1279      ENDIF
     1280
     1281
    10501282c======================================================================
    1051 cIM BEG
    1052         DO k=1, nlevENS
    1053           DO l=1, nlevSTD
    1054 c
    1055             bb=clevSTD(l)
    1056 c
    1057             IF(l.GE.2) THEN
    1058              aa=clevSTD(l)
    1059              bb=aa(1:lnblnk1(aa))
    1060             ENDIF
    1061 c
    1062             IF(bb.EQ.clev(k)) THEN
    1063 c             print*,'k=',k,'l=',l,'clev=',clev(k)
    1064               indENS(k)=l
    1065 c             print*,'k=',k,'l=',l,'clev=',clev(k),'indENS=',indENS(k)
    1066             ENDIF
    1067 c
    1068           ENDDO
    1069         ENDDO
    1070 c
    1071       ENDIF !debut
    1072 cIM END
    10731283      xjour = rjourvrai
    10741284c
    … …  
    10981308         itaprad = 0
    10991309         CALL phyetat0 ("startphy.nc",dtime,co2_ppm_etat0,solaire_etat0,
    1100      .       rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsurf,qsol,fsnow,
     1310     .       rlat,rlon,pctsrf, ftsol,ftsoil,
     1311cIM "slab" ocean
     1312     .       tslab,seaice,
     1313     .       fqsurf,qsol,fsnow,
    11011314     .       falbe, falblw, fevap, rain_fall,snow_fall,solsw, sollwdown,
    11021315     .       dlw,radsol,frugs,agesno,clesphy0,
    … …  
    11161329         ENDIF
    11171330
     1331cIM cf. AM 081204 BEG
     1332         PRINT*,'cycle_diurne3 =',cycle_diurne
     1333cIM cf. AM 081204 END
     1334c
     1335         IF(ocean.NE.'force ') THEN
     1336          ok_ocean=.TRUE.
     1337         ENDIF
    11181338c
    11191339         CALL printflag( tabcntr0,radpas,ok_ocean,ok_oasis ,ok_journe,
    … …  
    11911411     .                   lmt_pas
    11921412c
    1193          ecrit_mth = NINT(86400./dtime *ecritphy)  ! tous les ecritphy jours
    1194          IF (ok_mensuel) THEN
    1195          WRITE(lunout,*)'La frequence de sortie mensuelle est de ',
    1196      .                   ecrit_mth
    1197          ENDIF
    1198          ecrit_day = NINT(86400./dtime *1.0)  ! tous les jours
    1199          IF (ok_journe) THEN
    1200          WRITE(lunout,*)'La frequence de sortie journaliere est de ',
    1201      .                   ecrit_day
    1202          ENDIF
     1413cIM200505        ecrit_mth = NINT(86400./dtime *ecritphy)  ! tous les ecritphy jours
     1414c        IF (ok_mensuel) THEN
     1415c        WRITE(lunout,*)'La frequence de sortie mensuelle est de ',
     1416c    .                   ecrit_mth
     1417c        ENDIF
     1418c        ecrit_day = NINT(86400./dtime *1.0)  ! tous les jours
     1419c        IF (ok_journe) THEN
     1420c        WRITE(lunout,*)'La frequence de sortie journaliere est de ',
     1421c    .                   ecrit_day
     1422c        ENDIF
     1423cIM 130904 BEG
     1424cIM 080205      ecrit_hf = 86400./dtime *0.25  ! toutes les 6h
     1425cIM 170305     
     1426c        ecrit_hf = 86400./dtime/12.  ! toutes les 2h
     1427cIM 230305     
     1428cIM200505        ecrit_hf = 86400./dtime *0.25  ! toutes les 6h
     1429c
     1430cIM200505        ecrit_hf2mth = ecrit_day/ecrit_hf*30
     1431c
     1432cIM200505        IF (ok_journe) THEN
     1433cIM200505        WRITE(lunout,*)'La frequence de sortie hf est de ',
     1434cIM200505    .                   ecrit_hf
     1435cIM200505        ENDIF
     1436cIM 130904 END
    12031437ccc         ecrit_ins = NINT(86400./dtime *0.5)  ! 2 fois par jour
    12041438ccc         ecrit_ins = NINT(86400./dtime *0.25)  ! 4 fois par jour
    1205          ecrit_ins = NINT(86400./dtime/48.)  ! a chaque pas de temps ==> PB. dans time_counter pour 1mois
    1206          ecrit_ins = NINT(86400./dtime/12.)  ! toutes les deux heures
    1207          IF (ok_instan) THEN
    1208          WRITE(lunout,*)'La frequence de sortie instant. est de ',
    1209      .                   ecrit_ins
    1210          ENDIF
    1211          ecrit_reg = NINT(86400./dtime *0.25)  ! 4 fois par jour
    1212          IF (ok_region) THEN
    1213          WRITE(lunout,*)'La frequence de sortie region est de ',
    1214      .                   ecrit_reg
    1215          ENDIF
    1216 
     1439c        ecrit_ins = NINT(86400./dtime/48.)  ! a chaque pas de temps ==> PB. dans time_counter pour 1mois
     1440c        ecrit_ins = NINT(86400./dtime/12.)  ! toutes les deux heures
     1441cIM200505        ecrit_ins = NINT(86400./dtime/8.)  ! toutes les trois heures
     1442cIM200505        IF (ok_instan) THEN
     1443cIM200505        WRITE(lunout,*)'La frequence de sortie instant. est de ',
     1444cIM200505    .                   ecrit_ins
     1445cIM200505        ENDIF
     1446cIM200505        ecrit_reg = NINT(86400./dtime *0.25)  ! 4 fois par jour
     1447cIM200505        IF (ok_region) THEN
     1448cIM200505        WRITE(lunout,*)'La frequence de sortie region est de ',
     1449cIM200505    .                   ecrit_reg
     1450cIM200505        ENDIF
     1451c
     1452cIM 230505 BEG
     1453         ecrit_ins = NINT(ecrit_ins/dtime)
     1454         ecrit_hf = NINT(ecrit_hf/dtime)
     1455c        ecrit_hf2mth = 4*30
     1456         ecrit_day = NINT(ecrit_day/dtime)
     1457         ecrit_mth = NINT(ecrit_mth/dtime)
     1458         ecrit_tra = NINT(ecrit_tra/dtime)
     1459         ecrit_reg = NINT(ecrit_reg/dtime)
     1460cIM 230505 END
    12171461c
    12181462c Initialiser le couplage si necessaire
    … …  
    12291473      endif       
    12301474c
    1231 c
    1232 cIM
    12331475      capemaxcels = 't_max(X)'
    12341476      t2mincels = 't_min(X)'
    12351477      t2maxcels = 't_max(X)'
    1236 
     1478      tinst = 'inst(X)'
     1479      tave = 'ave(X)'
     1480cIM cf. AM 081204 BEG
     1481      write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
     1482cIM cf. AM 081204 END
    12371483c
    12381484c=============================================================
    … …  
    12481494#ifdef histday
    12491495#include "ini_histday.h"
     1496cIM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
     1497c#include "ini_bilKP_ins.h"
     1498c#include "ini_bilKP_ave.h"
     1499#include "ini_histday_seri.h"
    12501500#endif
    12511501
    … …  
    12731523#include "ini_histISCCP.h"
    12741524#endif
     1525
     1526c#undef histmthNMC
     1527c#define histmthNMC
     1528#ifdef histmthNMC
     1529#include "ini_histmthNMC.h"
     1530#endif
     1531
    12751532#endif
    12761533
    … …  
    15041761        rmu0 = -999.999
    15051762      ENDIF
    1506 cIM BEG
    1507       DO i=1, klon
    1508        sunlit(i)=1
    1509        IF(rmu0(i).EQ.0.) sunlit(i)=0
    1510        nbsunlit(1,i)=FLOAT(sunlit(i))
    1511       ENDDO
    1512 cIM END
     1763c
    15131764C     Calcul de l'abedo moyen par maille
    15141765      albsol(:)=0.
    … …  
    15451796     $            soil_model,cdmmax, cdhmax,
    15461797     $            ksta, ksta_ter, ok_kzmin, ftsoil, qsol,
    1547      $            paprs,pplay,radsol, fsnow,fqsurf,fevap,falbe,falblw,
     1798cIM BAD    $            paprs,pplay,radsol, fsnow,fqsurf,fevap,falbe,falblw,
     1799     $            paprs,pplay, fsnow,fqsurf,fevap,falbe,falblw,
    15481800     $            fluxlat,
    1549 cIM cf. JLD  e            rain_fall, snow_fall, solsw, sollw, sollwdown, fder,
    1550      e            rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder,
     1801     e            rain_fall, snow_fall,
     1802     e            fsolsw, fsollw, sollwdown, fder,
    15511803     e            rlon, rlat, cuphy, cvphy, frugs,
    15521804     e            debut, lafin, agesno,rugoro ,
    … …  
    15561808     s            dsens, devap,
    15571809     s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m,
    1558      s            fqcalving, ffonte, run_off_lic_0)
     1810cIM cf. AM 081204 BEG
     1811     s            pblh,capCL,oliqCL,cteiCL,pblT,
     1812     s            therm,trmb1,trmb2,trmb3,plcl,
     1813cIM cf. AM 081204 END
     1814     s            fqcalving, ffonte, run_off_lic_0,
     1815cIM "slab" ocean
     1816     s            fluxo, fluxg, tslab, seaice)
    15591817c
    15601818CXXX PB
    … …  
    16231881         zxffonte(i) = 0.0
    16241882         zxfqcalving(i) = 0.0
     1883cIM cf. AM 081204 BEG
     1884c
     1885         s_pblh(i) = 0.0
     1886         s_lcl(i) = 0.0
     1887         s_capCL(i) = 0.0
     1888         s_oliqCL(i) = 0.0
     1889         s_cteiCL(i) = 0.0
     1890         s_pblT(i) = 0.0
     1891         s_therm(i) = 0.0
     1892         s_trmb1(i) = 0.0
     1893         s_trmb2(i) = 0.0
     1894         s_trmb3(i) = 0.0
    16251895c
    16261896         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
    … …  
    16491919            zxfqcalving(i) = zxfqcalving(i) +
    16501920     .                      fqcalving(i,nsrf)*pctsrf(i,nsrf)
     1921cIM cf. AM 081204 BEG
     1922            s_pblh(i) = s_pblh(i) + pblh(i,nsrf)*pctsrf(i,nsrf)
     1923            s_lcl(i) = s_lcl(i) + plcl(i,nsrf)*pctsrf(i,nsrf)
     1924            s_capCL(i) = s_capCL(i) + capCL(i,nsrf) *pctsrf(i,nsrf)
     1925            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i,nsrf) *pctsrf(i,nsrf)
     1926            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i,nsrf) *pctsrf(i,nsrf)
     1927            s_pblT(i) = s_pblT(i) + pblT(i,nsrf) *pctsrf(i,nsrf)
     1928            s_therm(i) = s_therm(i) + therm(i,nsrf) *pctsrf(i,nsrf)
     1929            s_trmb1(i) = s_trmb1(i) + trmb1(i,nsrf) *pctsrf(i,nsrf)
     1930            s_trmb2(i) = s_trmb2(i) + trmb2(i,nsrf) *pctsrf(i,nsrf)
     1931            s_trmb3(i) = s_trmb3(i) + trmb3(i,nsrf) *pctsrf(i,nsrf)
    16511932c        ENDIF
    16521933        ENDDO
    … …  
    16681949          IF (pctsrf(i,nsrf) .LT. epsfra)
    16691950     .    fqcalving(i,nsrf) = zxfqcalving(i)
     1951cIM cf. AM 081204 BEG
     1952          IF (pctsrf(i,nsrf) .LT. epsfra) pblh(i,nsrf)=s_pblh(i)
     1953          IF (pctsrf(i,nsrf) .LT. epsfra) plcl(i,nsrf)=s_lcl(i)
     1954          IF (pctsrf(i,nsrf) .LT. epsfra) capCL(i,nsrf)=s_capCL(i)
     1955          IF (pctsrf(i,nsrf) .LT. epsfra) oliqCL(i,nsrf)=s_oliqCL(i)
     1956          IF (pctsrf(i,nsrf) .LT. epsfra) cteiCL(i,nsrf)=s_cteiCL(i)
     1957          IF (pctsrf(i,nsrf) .LT. epsfra) pblT(i,nsrf)=s_pblT(i)
     1958          IF (pctsrf(i,nsrf) .LT. epsfra) therm(i,nsrf)=s_therm(i)
     1959          IF (pctsrf(i,nsrf) .LT. epsfra) trmb1(i,nsrf)=s_trmb1(i)
     1960          IF (pctsrf(i,nsrf) .LT. epsfra) trmb2(i,nsrf)=s_trmb2(i)
     1961          IF (pctsrf(i,nsrf) .LT. epsfra) trmb3(i,nsrf)=s_trmb3(i)
    16701962        ENDDO
    16711963      ENDDO
    … …  
    20402332c 1. NUAGES CONVECTIFS
    20412333c
    2042       IF (iflag_cldcon.eq.-1) THEN ! seulement pour Tiedtke
     2334cIM cf FH
     2335c     IF (iflag_cldcon.eq.-1) THEN ! seulement pour Tiedtke
     2336       IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
     2337       snow_tiedtke=0.
     2338c     print*,'avant calcul de la pseudo precip '
     2339c     print*,'iflag_cldcon',iflag_cldcon
     2340       if (iflag_cldcon.eq.-1) then
     2341          rain_tiedtke=rain_con
     2342       else
     2343c       print*,'calcul de la pseudo precip '
     2344          rain_tiedtke=0.
     2345c         print*,'calcul de la pseudo precip 0'
     2346          do k=1,klev
     2347          do i=1,klon
     2348             if (d_q_con(i,k).lt.0.) then
     2349                rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys
     2350     s         *(paprs(i,k)-paprs(i,k+1))/rg
     2351             endif
     2352          enddo
     2353          enddo
     2354       endif
     2355c
     2356c     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
     2357c
    20432358
    20442359c Nuages diagnostiques pour Tiedtke
    20452360      CALL diagcld1(paprs,pplay,
    2046      .             rain_con,snow_con,ibas_con,itop_con,
     2361cIM cf FH  .             rain_con,snow_con,ibas_con,itop_con,
     2362     .             rain_tiedtke,snow_tiedtke,ibas_con,itop_con,
    20472363     .             diafra,dialiq)
    20482364      DO k = 1, klev
    … …  
    20722388      enddo
    20732389
     2390c
    20742391cIM calcul nuages par le simulateur ISCCP
     2392c
    20752393      IF (ok_isccp) THEN
    2076 cIM calcul tau. emi nuages convectifs
    2077       convfra(:,:)=rnebcon(:,:)
    2078       convliq(:,:)=rnebcon(:,:)*clwcon(:,:)
    2079       CALL newmicro (paprs, pplay,ok_newmicro,
    2080      .            t_seri, convliq, convfra, dtau_c, dem_c,
    2081      .            cldh_c, cldl_c, cldm_c, cldt_c, cldq_c,
    2082      .            flwp_c, fiwp_c, flwc_c, fiwc_c,
    2083      e            ok_aie,
    2084      e            sulfate, sulfate_pi,
    2085      e            bl95_b0, bl95_b1,
    2086      s            cldtaupi, re, fl)
    2087 c
    2088 cIM calcul tau. emi nuages startiformes
    2089       CALL newmicro (paprs, pplay,ok_newmicro,
    2090      .            t_seri, cldliq, cldfra, dtau_s, dem_s,
    2091      .            cldh_s, cldl_s, cldm_s, cldt_s, cldq_s,
    2092      .            flwp_s, fiwp_s, flwc_s, fiwc_s,
    2093      e            ok_aie,
    2094      e            sulfate, sulfate_pi,
    2095      e            bl95_b0, bl95_b1,
    2096      s            cldtaupi, re, fl)
    2097 c
    2098       cldtot(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
    2099 
    2100 cIM inversion des niveaux de pression ==> de haut en bas
    2101       CALL haut2bas(klon, klev, pplay, pfull)
    2102       CALL haut2bas(klon, klev, q_seri, qv)
    2103       CALL haut2bas(klon, klev, cldtot, cc)
    2104       CALL haut2bas(klon, klev, rnebcon, conv)
    2105       CALL haut2bas(klon, klev, dtau_s, dtau_sH2B)
    2106       CALL haut2bas(klon, klev, dtau_c, dtau_cH2B)
    2107       CALL haut2bas(klon, klev, t_seri, at)
    2108       CALL haut2bas(klon, klev, dem_s, dem_sH2B)
    2109       CALL haut2bas(klon, klev, dem_c, dem_cH2B)
    2110       CALL haut2bas(klon, klevp1, paprs, phalf)
    2111 
    2112 c     open(99,file='tautab.bin',access='sequential',
    2113 c    $     form='unformatted',status='old')
    2114 c     read(99) tautab
    2115 
    2116 cIM210503
    2117       IF (debut) THEN
    2118       open(99,file='tautab.formatted', FORM='FORMATTED')
    2119       read(99,'(f30.20)') tautab
    2120       close(99)
    2121 c
    2122       open(99,file='invtau.formatted',form='FORMATTED')
    2123       read(99,'(i10)') invtau
    2124       close(99)
    2125 c
    2126 cIM: calcul coordonnees regions pour statistiques distribution
    2127 cIM: nuages en ftion du regime dynamique pour regions oceaniques
    2128        IF (ok_regdyn) THEN !histREGDYN
    2129        nsrf=3
    2130        DO nreg=1, nbregdyn
    2131        DO i=1, klon
    2132 
    2133 c       IF (debut) THEN
    2134          IF(rlon(i).LT.0.) THEN
    2135            rlonPOS(i)=rlon(i)+360.
    2136          ELSE
    2137            rlonPOS(i)=rlon(i) 
    2138          ENDIF
    2139 c       ENDIF
    2140 
    2141         pct_ocean(i,nreg)=0
    2142 
    2143 c test si c'est 1 point d'ocean
    2144         IF(pctsrf(i,nsrf).EQ.1.) THEN
    2145 
    2146          IF(nreg.EQ.1) THEN
    2147 
    2148 c TROP
    2149           IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
    2150            pct_ocean(i,nreg)=1
    2151           ENDIF
    2152 
    2153 c PACIFIQUE NORD
    2154           ELSEIF(nreg.EQ.2) THEN
    2155            IF(rlat(i).GE.40.AND.rlat(i).LE.60.) THEN
    2156             IF(rlonPOS(i).GE.160..AND.rlonPOS(i).LE.235.) THEN
    2157              pct_ocean(i,nreg)=1
    2158             ENDIF
    2159            ENDIF
    2160 c CALIFORNIE ST-CU
    2161          ELSEIF(nreg.EQ.3) THEN
    2162           IF(rlonPOS(i).GE.220..AND.rlonPOS(i).LE.250.) THEN
    2163            IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
    2164             pct_ocean(i,nreg)=1
    2165            ENDIF
    2166           ENDIF
    2167 c HAWAI
    2168         ELSEIF(nreg.EQ.4) THEN
    2169          IF(rlonPOS(i).GE.180..AND.rlonPOS(i).LE.220.) THEN
    2170           IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
    2171            pct_ocean(i,nreg)=1
    2172           ENDIF
    2173          ENDIF
    2174 c WARM POOL
    2175         ELSEIF(nreg.EQ.5) THEN
    2176          IF(rlonPOS(i).GE.70..AND.rlonPOS(i).LE.150.) THEN
    2177           IF(rlat(i).GE.-5.AND.rlat(i).LE.20.) THEN
    2178            pct_ocean(i,nreg)=1
    2179           ENDIF
    2180          ENDIF
    2181         ENDIF !nbregdyn
    2182 c TROP
    2183 c        IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
    2184 c         pct_ocean(i)=.TRUE.
    2185 c         WRITE(*,*) 'pct_ocean =',i, rlon(i), rlat(i)
    2186 c          ENDIF !lon
    2187 c         ENDIF !lat
    2188 
    2189         ENDIF !pctsrf
    2190        ENDDO !klon
    2191        ENDDO !nbregdyn
    2192        ENDIF !ok_regdyn
    2193  
    2194 cIM somme de toutes les nhistoW BEG
    2195       DO nreg = 1, nbregdyn
    2196        DO k = 1, kmaxm1
    2197         DO l = 1, lmaxm1
    2198          DO iw = 1, iwmax
    2199           nhistoWt(k,l,iw,nreg)=0.
    2200          ENDDO !iw
    2201         ENDDO !l
    2202        ENDDO !k
    2203       ENDDO !nreg
    2204 cIM somme de toutes les nhistoW END
    2205       ENDIF
    2206 cIM: initialisation de seed
    2207         DO i=1, klon
    2208           seed(i)=i+100
    2209         ENDDO
    2210      
    2211 cIM: pas de debug, debugcol
    2212       debug=0
    2213       debugcol=0
    2214 cIM260503
    2215 c o500 ==> distribution nuage ftion du regime dynamique a 500 hPa
    2216         DO k=1, klevm1
    2217         kp1=k+1
    2218 c       PRINT*,'k, presnivs',k,presnivs(k), presnivs(kp1)
    2219         if(presnivs(k).GT.50000.AND.presnivs(kp1).LT.50000.) THEN
    2220          DO i=1, klon
    2221           o500(i)=omega(i,k)*RDAY/100.
    2222 c         if(i.EQ.1) print*,' 500hPa lev',k,presnivs(k),presnivs(kp1)
    2223          ENDDO
    2224          GOTO 1000
    2225         endif
    2226 1000  continue
    2227       ENDDO
    2228 
    2229       CALL ISCCP_CLOUD_TYPES(
    2230      &     debug,
    2231      &     debugcol,
    2232      &     klon,
    2233      &     sunlit,
    2234      &     klev,
    2235      &     ncol,
    2236      &     seed,
    2237      &     pfull,
    2238      &     phalf,
    2239      &     qv, cc, conv, dtau_sH2B, dtau_cH2B,
    2240      &     top_height,
    2241      &     overlap,
    2242      &     tautab,
    2243      &     invtau,
    2244      &     ztsol,
    2245      &     emsfc_lw,
    2246      &     at, dem_sH2B, dem_cH2B,
    2247      &     fq_isccp,
    2248      &     totalcldarea,
    2249      &     meanptop,
    2250      &     meantaucld,
    2251      &     boxtau,
    2252      &     boxptop)
    2253 
    2254 
    2255 c passage de la grille (klon,7,7) a (iim,jjmp1,7,7)
    2256       DO l=1, lmaxm1
    2257        DO k=1, kmaxm1
    2258         DO i=1, iim
    2259          fq4d(i,1,k,l)=fq_isccp(1,k,l)
    2260         ENDDO
    2261         DO j=2, jjm
    2262          DO i=1, iim
    2263           ig=i+1+(j-2)*iim
    2264           fq4d(i,j,k,l)=fq_isccp(ig,k,l)             
    2265          ENDDO
    2266         ENDDO
    2267         DO i=1, iim
    2268          fq4d(i,jjmp1,k,l)=fq_isccp(klon,k,l)
    2269         ENDDO
    2270        ENDDO
    2271       ENDDO
    2272 c
    2273       DO l=1, lmaxm1
    2274        DO k=1, kmaxm1 
    2275         DO j=1, jjmp1
    2276          DO i=1, iim
    2277            ni=(i-1)*lmaxm1+l
    2278            nj=(j-1)*kmaxm1+k
    2279            fq3d(ni,nj)=fq4d(i,j,k,l)
    2280          ENDDO
    2281         ENDDO
    2282        ENDDO
    2283       ENDDO
    2284 
    2285 c
    2286 c calculs statistiques distribution nuage ftion du regime dynamique
    2287 c
    2288 c Ce calcul doit etre fait a partir de valeurs mensuelles ??
    2289       CALL histo_o500_pctau(nbregdyn,pct_ocean,o500,fq_isccp,
    2290      &histoW,nhistoW)
    2291 c
    2292 c nhistoWt = somme de toutes les nhistoW
    2293       DO nreg=1, nbregdyn
    2294        DO k = 1, kmaxm1
    2295         DO l = 1, lmaxm1
    2296          DO iw = 1, iwmax
    2297           nhistoWt(k,l,iw,nreg)=nhistoWt(k,l,iw,nreg)+
    2298      &    nhistoW(k,l,iw,nreg)
    2299          ENDDO
    2300         ENDDO
    2301        ENDDO
    2302       ENDDO
    2303 c
     2394#include "calcul_simulISCCP.h"
    23042395      ENDIF !ok_isccp
    23052396
    … …  
    25712662     e                   igwd,idx,itest,
    25722663     e                   t_seri, u_seri, v_seri,
    2573      s                   zulow, zvlow, zustr, zvstr,
     2664cIM 141004    s                   zulow, zvlow, zustr, zvstr,
     2665     s                   zulow, zvlow, zustrdr, zvstrdr,
    25742666     s                   d_t_oro, d_u_oro, d_v_oro)
    25752667c
    … …  
    26032695     e                   itest,
    26042696     e                   t_seri, u_seri, v_seri,
    2605      s                   zulow, zvlow, zustr, zvstr,
     2697     s                   zulow, zvlow, zustrli, zvstrli,
    26062698     s                   d_t_lif, d_u_lif, d_v_lif)
    26072699c
    … …  
    26162708c
    26172709      ENDIF ! fin de test sur ok_orolf
     2710c
     2711cIM cf. FLott BEG
     2712C STRESS NECESSAIRES: TOUTE LA PHYSIQUE
     2713
     2714      DO i = 1, klon
     2715        zustrph(i)=0.
     2716        zvstrph(i)=0.
     2717      ENDDO
     2718      DO k = 1, klev
     2719      DO i = 1, klon
     2720       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
     2721     c            (paprs(i,k)-paprs(i,k+1))/rg
     2722       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
     2723     c            (paprs(i,k)-paprs(i,k+1))/rg
     2724      ENDDO
     2725      ENDDO
     2726c
     2727cIM calcul composantes axiales du moment angulaire et couple des montagnes
     2728c
     2729      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
     2730     C               ra,rg,romega,
     2731     C               rlat,rlon,pphis,
     2732     C               zustrdr,zustrli,zustrph,
     2733     C               zvstrdr,zvstrli,zvstrph,
     2734     C               paprs,u,v,
     2735     C               aam, torsfc)
     2736cIM cf. FLott END
    26182737c
    26192738      IF (if_ebil.ge.2) THEN
    … …  
    27122831     s                   ve, vq, ue, uq)
    27132832c
     2833cIM diag. bilKP
     2834c
     2835      CALL transp_lay (paprs,zxtsol,
     2836     e                   t_seri, q_seri, u_seri, v_seri, zphi,
     2837     s                   ve_lay, vq_lay, ue_lay, uq_lay)
     2838c
    27142839c Accumuler les variables a stocker dans les fichiers histoire:
    2715 c
    2716 c
    27172840c
    27182841c+jld ec_conser
    … …  
    27502873c=======================================================================
    27512874
    2752 c   Interpollation sur quelques niveaux de pression
    2753 c   -----------------------------------------------
    2754 c
    2755 c on moyenne mensuellement les champs 3D et on les interpole sur les niveaux STD
    2756 c     if(itap.EQ.1.OR.itap.EQ.13.OR.itap.EQ.25.OR.itap.EQ.37) THEN
    2757 c     if(MOD(itap,12).EQ.1) THEN
    2758 cIM 120304 END
    2759       DO k=1, nlevSTD
    2760        call plevel(klon,klev,.true.,pplay,rlevSTD(k),
    2761      .             t_seri,tlevSTD(:,k))
    2762        call plevel(klon,klev,.false.,pplay,rlevSTD(k),
    2763      .             u_seri,ulevSTD(:,k))
    2764        call plevel(klon,klev,.false.,pplay,rlevSTD(k),
    2765      .             v_seri,vlevSTD(:,k))
    2766        call plevel(klon,klev,.false.,pplay,rlevSTD(k),
    2767      .             zphi,philevSTD(:,k))
    2768        call plevel(klon,klev,.false.,pplay,rlevSTD(k),
    2769      .             qx(:,:,ivap),qlevSTD(:,k))
    2770        call plevel(klon,klev,.false.,pplay,rlevSTD(k),
    2771      .             zx_rh,rhlevSTD(:,k))
    2772       ENDDO !nlevSTD
    2773 c ENSEMBLES BEG
    2774       DO k=1, nlevENS
    2775 cIM 170304
    2776        tlev(:,k)=tlevSTD(:,indENS(k))
    2777        ulev(:,k)=ulevSTD(:,indENS(k))
    2778        vlev(:,k)=vlevSTD(:,indENS(k))
    2779        philev(:,k)=philevSTD(:,indENS(k))
    2780        qlev(:,k)=qlevSTD(:,indENS(k))
    2781        rhlev(:,k)=rhlevSTD(:,indENS(k))
    2782 c
    2783        call plevel(klon,klevp1,.true.,paprs,rlevENS(k),
    2784      .             omega,wlev(:,k))
    2785 c
    2786        ENDDO !k=1, nlevENS
    2787 cIM 100304 BEG
    2788 cIM interpolation a chaque pas de temps du SWup(clr) et SWdn(clr) a 200 hPa
    2789       call plevel(klon,klevp1,.true.,paprs,20000.,
    2790      $     swdn0,SWdn200clr)
    2791       call plevel(klon,klevp1,.false.,paprs,20000.,
    2792      $     swdn,SWdn200)
    2793       call plevel(klon,klevp1,.false.,paprs,20000.,
    2794      $     swup0,SWup200clr)
    2795       call plevel(klon,klevp1,.false.,paprs,20000.,
    2796      $     swup,SWup200)
    2797 c
    2798       call plevel(klon,klevp1,.false.,paprs,20000.,
    2799      $     lwdn0,LWdn200clr)
    2800       call plevel(klon,klevp1,.false.,paprs,20000.,
    2801      $     lwdn,LWdn200)
    2802       call plevel(klon,klevp1,.false.,paprs,20000.,
    2803      $     lwup0,LWup200clr)
    2804       call plevel(klon,klevp1,.false.,paprs,20000.,
    2805      $     lwup,LWup200)
    2806 c
    2807 cIM 100304 END
    2808 c     
    2809 c ENSEMBLES END
     2875cIM Interpolation sur les niveaux de pression du NMC
     2876c   -------------------------------------------------
     2877c
     2878#include "calcul_STDlev.h"
    28102879c
    28112880c slp sea level pressure
    … …  
    28212890      ENDDO
    28222891c
    2823 cIM sorties bilans energie cinetique et potentielle MJO
    2824       DO k = 1, klev
    2825       DO i = 1, klon
    2826         d_u_oli(i,k) = d_u_oro(i,k) + d_u_lif(i,k)
    2827         d_v_oli(i,k) = d_v_oro(i,k) + d_v_lif(i,k)
    2828       ENDDO
    2829       ENDDO
    2830 c
    2831       IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
    2832 cIM      PRINT *,' PHYS cond  julien ',julien
    2833 c        CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
    2834         DO i = 1, klon
    2835          total_rain(i)=rain_fall(i)+snow_fall(i) 
    2836          IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.
    2837         ENDDO
    2838 c
    2839       ENDIF
    2840 c surface terre
    2841       IF (debut) THEN
    2842        DO i=1, klon
    2843          IF(pctsrf_new(i,is_ter).GT.0.) THEN
    2844             paire_ter(i)=airephy(i)*pctsrf_new(i,is_ter)
    2845          ENDIF
    2846        ENDDO
    2847       ENDIF
    2848 cIM 050204 END
    2849 
     2892cIM initialisation + calculs divers diag AMIP2
     2893c
     2894#include "calcul_divers.h"
     2895c
    28502896c=============================================================
    28512897c
    … …  
    28722918      ENDIF
    28732919c
     2920cIM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
     2921c#include "write_bilKP_ins.h"
     2922c#include "write_bilKP_ave.h"
     2923c
    28742924c Sauvegarder les valeurs de t et q a la fin de la physique:
    28752925c
    … …  
    28932943#ifdef histday
    28942944#include "write_histday.h"
     2945#include "write_histday_seri.h"
    28952946#endif
    28962947
    … …  
    29102961#include "write_histISCCP.h"
    29112962#endif
     2963
    29122964
    29132965#ifdef histmthNMC
    … …  
    29573009ccc         IF (ok_oasis) CALL quitcpl
    29583010         CALL phyredem ("restartphy.nc",dtime,radpas,
    2959      .      rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsurf, qsol,
     3011     .      rlat, rlon, pctsrf, ftsol, ftsoil,
     3012cIM "slab" ocean
     3013     .      tslab, seaice,
     3014     .      fqsurf, qsol,
    29603015     .      fsnow, falbe,falblw, fevap, rain_fall, snow_fall,
    29613016     .      solsw, sollwdown,dlw,
Note: See TracChangeset for help on using the changeset viewer.