Changeset 486 for LMDZ.3.3


Ignore:
Timestamp:
Dec 15, 2003, 6:50:41 PM (21 years ago)
Author:
lmdzadmin
Message:

Phasage avec la version de Ionela
IM/LF

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

Legend:

Unmodified
Added
Removed

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

    r433 r486  
    182182      END
    183183c========================================================================
    184       SUBROUTINE albsno(veget, agesno, alb_neig)
    185       IMPLICIT none
    186 c
    187 #include "dimensions.h"
    188 #include "dimphy.h"
    189       INTEGER nvm
    190       PARAMETER (nvm=8)
    191       REAL veget(klon,nvm)
    192       REAL alb_neig(klon)
    193       REAL agesno(klon)
    194 c
    195       INTEGER i, nv
    196 c
    197       REAL init(nvm), decay(nvm), as
    198       SAVE init, decay
    199       DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./
    200       DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./
    201 c
    202       DO i = 1, klon
    203          alb_neig(i) = 0.0
    204       ENDDO
    205       DO nv = 1, nvm
    206          DO i = 1, klon
    207             as = init(nv)+decay(nv)*EXP(-agesno(i)/5.)
    208             alb_neig(i) = alb_neig(i) + veget(i,nv)*as
    209          ENDDO
    210       ENDDO
    211 c
    212       RETURN
    213       END

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

    r467 r486  
    1111cIM seuils cdrm, cdrh
    1212       REAL cdmmax, cdhmax
     13cIM param. stabilite s/ terres et en dehors
     14       REAL ksta, ksta_ter
     15cIM ok_kzmin : clef calcul Kzmin dans la CL de surface cf FH
     16       LOGICAL ok_kzmin
    1317
    1418       COMMON/clesphys/cycle_diurne, soil_model, new_oliq,
    … …  
    1620     ,     , co2_ppm, solaire, RCO2, RCH4, RN2O, RCFC11, RCFC12
    1721     ,     , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
    18      ,     , top_height, overlap, cdmmax, cdhmax
     22     ,     , top_height, overlap, cdmmax, cdhmax, ksta, ksta_ter
     23     ,     , ok_kzmin

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

    r467 r486  
    99       INTEGER :: top_height, overlap
    1010       REAL :: cdmmax, cdhmax
     11       REAL :: ksta, ksta_ter
     12       LOGICAL :: ok_kzmin
    1113
    1214       COMMON/clesphys/cycle_diurne, soil_model, new_oliq, &
    … …  
    1416     &     , co2_ppm, solaire, RCO2, RCH4, RN2O, RCFC11, RCFC12 &
    1517     &     , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt &
    16      &     , top_height, overlap, cdmmax, cdhmax
     18     &     , top_height, overlap, cdmmax, cdhmax, ksta, ksta_ter &
     19     &     , ok_kzmin

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

    r475 r486  
    77     .                  jour, rmu0, co2_ppm,
    88     .                  ok_veget, ocean, npas, nexca, ts,
    9      .                  soil_model,cdmmax, cdhmax, ftsoil,qsol,
     9     .                  soil_model,cdmmax, cdhmax,
     10     .                  ksta, ksta_ter, ok_kzmin, ftsoil,qsol,
    1011     .                  paprs,pplay,radsol,snow,qsurf,evap,albe,alblw,
    1112     .                  fluxlat,
    … …  
    143144cIM ajout seuils cdrm, cdrh
    144145      REAL cdmmax, cdhmax
     146cIM: 261103
     147      REAL ksta, ksta_ter
     148      LOGICAL ok_kzmin
     149cIM: 261103
    145150      REAL ftsoil(klon,nsoilmx,nbsrf)
    146151      REAL ytsoil(klon,nsoilmx)
    … …  
    472477c calculer Cdrag et les coefficients d'echange
    473478      CALL coefkz(nsrf, knon, ypaprs, ypplay,
     479cIM 261103
     480     .     ksta, ksta_ter,
     481cIM 261103
    474482     .            yts, yrugos, yu, yv, yt, yq,
    475483     .            yqsurf,
    … …  
    494502      endif
    495503
     504c
     505cIM: 261103
     506      if (ok_kzmin) THEN
     507cIM cf FH: 201103 BEG
     508c   Calcul d'une diffusion minimale pour les conditions tres stables.
     509      call coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycoefm
     510     .   ,ycoefm0,ycoefh0)
     511c      call dump2d(iim,jjm-1,ycoefm(2:klon-1,2), 'KZ         ')
     512c      call dump2d(iim,jjm-1,ycoefm0(2:klon-1,2),'KZMIN      ')
     513 
     514       if ( 1.eq.1 ) then
     515       DO k = 1, klev
     516       DO i = 1, knon
     517          ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
     518          ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
     519       ENDDO
     520       ENDDO
     521       endif
     522cIM cf FH: 201103 END
     523      endif !ok_kzmin
     524cIM: 261103
     525
     526c
    496527c calculer la diffusion des vitesses "u" et "v"
    497528      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
    … …  
    503534      ytaux = y_flux_u(:,1)
    504535      ytauy = y_flux_v(:,1)
    505 
    506       if (nsrf.eq.is_oce) then
    507          do j=1,knon
    508             ycoefm(j,1)=1.e-3
    509 c            ycoefh(j,1)=0.8*ycoefm(j,1)
    510          enddo
    511       endif
    512536
    513537c FH modif sur le cdrag temperature
    … …  
    737761#else
    738762       DO j=1, knon
     763         i = ni(j)
    739764         t2m(i,nsrf)=0.
    740765         q2m(i,nsrf)=0.
    … …  
    12191244      END
    12201245      SUBROUTINE coefkz(nsrf, knon, paprs, pplay,
     1246cIM 261103
     1247     .                  ksta, ksta_ter,
     1248cIM 261103
    12211249     .                  ts, rugos,
    12221250     .                  u,v,t,q,
    … …  
    12791307      PARAMETER (prandtl=0.4)
    12801308      REAL kstable ! diffusion minimale (situation stable)
    1281       PARAMETER (kstable=1.0e-10)
     1309      ! GKtest
     1310      ! PARAMETER (kstable=1.0e-10)
     1311      REAL ksta, ksta_ter
     1312cIM: 261103     REAL kstable_ter, kstable_sinon
     1313cIM: 211003 cf GK   PARAMETER (kstable_ter = 1.0e-6)
     1314cIM: 261103     PARAMETER (kstable_ter = 1.0e-8)
     1315cIM: 261103   PARAMETER (kstable_ter = 1.0e-10)
     1316cIM: 261103   PARAMETER (kstable_sinon = 1.0e-10)
     1317      ! fin GKtest
    12821318      REAL mixlen ! constante controlant longueur de melange
    12831319      PARAMETER (mixlen=35.0)
    … …  
    13711407         gamt(2) = -2.5E-03
    13721408      ENDIF
     1409cIM cf JLD/ GKtest
     1410      IF ( nsrf .EQ. is_ter ) THEN
     1411cIM 261103     kstable = kstable_ter
     1412        kstable = ksta_ter
     1413      ELSE
     1414cIM 261103     kstable = kstable_sinon
     1415        kstable = ksta
     1416      ENDIF
     1417cIM cf JLD/ GKtest fin
    13731418c
    13741419c Calculer les geopotentiels de chaque couche
    … …  
    16141659      DO k = 2, klev
    16151660      DO i = 1, knon
    1616       IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean
    1617      .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion
    1618      .     (zdthmin(i).GT.seuil) )THEN ! si l'inversion est trop faible
     1661cIM cf FH/GK   IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean
     1662cIM cf FH/GK  .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion
     1663      !IM cf JLD/ GKtest TERkz2
     1664      ! IF ( (nsrf.EQ.is_ter) .OR.  ! si on est sur la terre
     1665      ! fin GKtest
     1666      IF ( (nsrf.EQ.is_oce) .AND.  ! si on est sur ocean et si
     1667     .     ( (invb(i).EQ.klev) .OR.      ! s'il n'y a pas d'inversion
     1668     .     (zdthmin(i).GT.seuil) ) )THEN ! si l'inversion est trop faible
    16191669         zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,klev+1))
    16201670     .                       /(paprs(i,2)-paprs(i,klev+1)) ))**2

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/conf_phys.F90

    r480 r486  
    442442  call getin('cdhmax',cdhmax)
    443443
     444!261103
     445!
     446!Config Key  = ksta
     447!Config Desc =
     448!Config Def  = 1.0e-10
     449!Config Help =
     450!
     451  ksta = 1.0e-10
     452  call getin('ksta',ksta)
     453
     454!
     455!Config Key  = ksta_ter
     456!Config Desc =
     457!Config Def  = 1.0e-10
     458!Config Help =
     459!
     460  ksta_ter = 1.0e-10
     461  call getin('ksta_ter',ksta_ter)
     462
     463!
     464!Config Key  = ok_kzmin
     465!Config Desc =
     466!Config Def  = .true.
     467!Config Help =
     468!
     469  ok_kzmin = .true.
     470  call getin('ok_kzmin',ok_kzmin)
     471
     472!261103
    444473!
    445474!Config Key  =
    … …  
    495524  write(numout,*)' top_height = ',top_height
    496525  write(numout,*)' overlap = ',overlap
     526  write(numout,*)' cdmmax = ',cdmmax
     527  write(numout,*)' cdhmax = ',cdhmax
     528  write(numout,*)' ksta = ',ksta
     529  write(numout,*)' ksta_ter = ',ksta_ter
     530  write(numout,*)' ok_kzmin = ',ok_kzmin
    497531
    498532  return

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

    r433 r486  
     1c
     2c $Header$
     3c
    14      SUBROUTINE cv3_param(nd,delt)
    25      implicit none
    … …  
    14591462      real asum(nloc,nd),bsum(nloc,nd),csum(nloc,nd)
    14601463      real wgh
     1464      real zm(nloc,na)
    14611465      logical lwork(nloc)
    14621466
    … …  
    14981502       enddo
    14991503      enddo
     1504      zm(:,:)=0.
    15001505
    15011506c=====================================================================
    … …  
    15791584      vent(il,i,i)=v(il,nk(il))
    15801585      elij(il,i,i)=clw(il,i)
    1581       sij(il,i,i)=1.0
     1586cMAF      sij(il,i,i)=1.0
     1587      sij(il,i,i)=0.0
    15821588      end if
    15831589 740  continue
    … …  
    17531759        vent(il,i,i)=v(il,nk(il))
    17541760        elij(il,i,i)=clw(il,i)
    1755         sij(il,i,i)=1.0
     1761cMAF        sij(il,i,i)=1.0
     1762        sij(il,i,i)=0.0
    17561763       endif
    17571764      enddo ! il
    … …  
    17671774
    17681775789   continue
    1769      
     1776c     
     1777c MAF: renormalisation de MENT
     1778      do jm=1,nd
     1779        do im=1,nd
     1780          do il=1,ncum
     1781          zm(il,im)=zm(il,im)+(1.-sij(il,im,jm))*ment(il,im,jm)
     1782         end do
     1783        end do
     1784      end do
     1785c
     1786      do jm=1,nd
     1787        do im=1,nd
     1788          do il=1,ncum
     1789          if(zm(il,im).ne.0.) then
     1790          ment(il,im,jm)=ment(il,im,jm)*m(il,im)/zm(il,im)
     1791          endif
     1792         end do
     1793       end do
     1794      end do
     1795c
    17701796      do jm=1,nd
    17711797       do im=1,nd
    … …  
    20792105      do j=1,ntra
    20802106      trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
    2081      :            +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
     2107ctestmaf     :            +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
     2108     :            +tra(il,i,j)*(mp(il,i)-mp(il,i+1))
    20822109      trap(il,i,j)=trap(il,i,j)/mp(il,i)
    20832110      end do
    … …  
    26362663          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
    26372664     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
    2638      :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
     2665     :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
    26392666         else
    26402667          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
    26412668     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
    2642      :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
     2669     :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
    26432670         endif
    26442671        endif ! i
    … …  
    26922719        ex=0.1*ment(il,inb(il),inb(il))
    26932720     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
    2694      :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
     2721     :      /(ph(il,inb(il))-ph(il,inb(il)+1))
    26952722        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
    26962723        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
    … …  
    27922819      enddo
    27932820
    2794       do i=1,nl
     2821      do i=2,nl
    27952822       do k=i,nl
    27962823        do il=1,ncum
    2797          if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) then
     2824ctest         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) then
     2825         if (i.le.inb(il).and.k.le.inb(il)) then
    27982826            upwd(il,i)=upwd(il,i)+m(il,k)+up1(il,k,i)
    27992827            dnwd(il,i)=dnwd(il,i)+dn1(il,k,i)
    … …  
    30243052
    30253053        do 2100 j=1,ntra
    3026 c oct3         do 2110 k=1,nl
    30273054         do 2110 k=1,nd ! oct3
    30283055          do 2120 i=1,ncum

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

    r2 r486  
     1c
     2c $Header$
     3c
    14      SUBROUTINE hydrol(dtime,pctsrf,rain_fall,snow_fall,evap,
    25     .                  agesno, tsol,qsol,snow,runoff)
    … …  
    7679c je limite la temperature a RTT-1.8 (il faudrait aussi prendre l'eau de
    7780c la fonte) (Laurent Li, le 14mars98):
    78       tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
     81cIM cf GK   tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
     82cIM cf GK : la glace fond a 0C, non pas a -1.8
     83            tsol(i,is) = MIN(tsol(i,is),RTT)
    7984c
    8085ccc         ELSE
    … …  
    95100c je limite la temperature a RTT-1.8 (il faudrait aussi prendre l'eau de
    96101c la fonte) (Laurent Li, le 14mars98):
    97       tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
     102cIM cf GK   tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
     103cIM cf GK : la glace fond a 0C, non pas a -1.8
     104            tsol(i,is) = MIN(tsol(i,is),RTT)
    98105c
    99106ccc         ELSE

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

    r467 r486  
    233233     .                capemaxcels, zsto,zout)
    234234
    235          CALL histdef(nid_day, "SWupTOAclr",
    236      .                "SWup clear sky at TOA","W/m2",
    237      .                iim,jjmp1,nhori, 1,1,1,-99,
    238      .                32, "ave(X)", zsto,zout)
    239 
    240          CALL histdef(nid_day, "SWupSFCclr",
    241      .                "SWup clear sky at surface","W/m2",
    242      .                iim,jjmp1,nhori, 1,1,1,-99,
    243      .                32, "ave(X)", zsto,zout)
    244 
    245          CALL histdef(nid_day, "SWdnTOAclr",
    246      .                "SWdn clear sky at TOA","W/m2",
    247      .                iim,jjmp1,nhori, 1,1,1,-99,
    248      .                32, "ave(X)", zsto,zout)
    249 
    250          CALL histdef(nid_day, "SWdnSFCclr",
    251      .                "SWdn clear sky at surface","W/m2",
    252      .                iim,jjmp1,nhori, 1,1,1,-99,
    253      .                32, "ave(X)", zsto,zout)
    254235
    255236c=================================================================
    … …  
    438419     .                "ave(X)", zsto,zout)
    439420c
    440 cccIM   
    441          CALL histdef(nid_day, "SWupTOA", "SWup at TOA","W/m2",
    442      .                iim,jjmp1,nhori, 1,1,1,-99,
    443      .                32, "ave(X)", zsto,zout)
    444 c
    445          CALL histdef(nid_day, "SWupSFC", "SWup at surface","W/m2",
    446      .                iim,jjmp1,nhori, 1,1,1,-99,
    447      .                32, "ave(X)", zsto,zout)
    448 c
    449          CALL histdef(nid_day, "SWdnTOA", "SWdn at TOA","W/m2",
    450      .                iim,jjmp1,nhori, 1,1,1,-99,
    451      .                32, "ave(X)", zsto,zout)
    452 c
    453          CALL histdef(nid_day, "SWdnSFC", "SWdn at surface","W/m2",
    454      .                iim,jjmp1,nhori, 1,1,1,-99,
    455      .                32, "ave(X)", zsto,zout)
    456 c
    457          CALL histend(nid_day)
    458421c
    459422c=================================================================

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

    r471 r486  
    116116     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    117117     .                "ave(X)", zsto,zout)
    118 c
    119          CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface",
     118cIM: 071003
     119         CALL histdef(nid_mth,"LWdnSFC","Down. IR rad. at surface",
     120     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
     121     .                "ave(X)", zsto,zout)
     122cIM: 071003
     123         CALL histdef(nid_mth,"LWupSFC","Upwd. IR rad. at surface",
    120124     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
    121125     .                "ave(X)", zsto,zout)
    … …  
    263267     .                "ave(X)", zsto,zout)
    264268c
    265          CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
    266      .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     269         CALL histdef(nid_mth,"cldq","Cloud liquid water path","Kg/m2",
     270     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     271     .                "ave(X)", zsto,zout)
     272cIM: 071003
     273         CALL histdef(nid_mth,"lwp","Cloud water path","Kg/m2",
     274     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     275     .                "ave(X)", zsto,zout)
     276c
     277         CALL histdef(nid_mth,"iwp","Cloud ice water path","Kg/m2",
     278     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     279     .                "ave(X)", zsto,zout)
     280cIM: 071003
     281         CALL histdef(nid_mth,"lwcon","Cloud water content","Kg/Kg",
     282     .                iim,jjmp1,nhori, klev,1,klev, nvert, 32,
     283     .                "ave(X)", zsto,zout)
     284c
     285         CALL histdef(nid_mth,"iwcon","Cloud ice water content","Kg/Kg",
     286     .                iim,jjmp1,nhori, klev,1,klev, nvert, 32,
    267287     .                "ave(X)", zsto,zout)
    268288c
    … …  
    334354     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
    335355     .                "ave(X)", zsto,zout)
     356cIM: 071003
     357         CALL histdef(nid_mth,"wvap","Water vapor mixing ratio","Kg/Kg",
     358     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
     359     .                "ave(X)", zsto,zout)
    336360c
    337361         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
    … …  
    374398c
    375399         CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
     400     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
     401     .                "ave(X)", zsto,zout)
     402c
     403         CALL histdef(nid_mth, "dtphy", "Physics dT", "K/s",
    376404     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
    377405     .                "ave(X)", zsto,zout)
    … …  
    400428     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
    401429     .                "ave(X)", zsto,zout)
     430cIM: 071003
     431         CALL histdef(nid_mth, "dtlschr",
     432     $       "Large-scale condensational heating rate", "K/s",iim,jjmp1
     433     $       ,nhori, klev,1,klev,nvert, 32,"ave(X)", zsto,zout)
    402434c
    403435         CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
    … …  
    442474     .                "ave(X)", zsto,zout)
    443475c
    444          CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
     476         CALL histdef(nid_mth, "dtsw0", "CS SW radiation dT", "K/s",
    445477     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
    446478     .                "ave(X)", zsto,zout)
    … …  
    450482     .                "ave(X)", zsto,zout)
    451483c
    452          CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
     484         CALL histdef(nid_mth,"dtlw0","CS LW radiation dT","K/s",
    453485     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
    454486     .                "ave(X)", zsto,zout)

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

    r479 r486  
    694694     alb_new(1 : knon)  = alb_neig(1 : knon)*zfra(1:knon) + &
    695695    &                     0.6 * (1.0-zfra(1:knon))
    696 !!     alb_new(1 : knon)  = 0.6
     696!IM cf FH/GK     alb_new(1 : knon)  = 0.6
     697!       alb_new(1 : knon)  = 0.82
     698!IM cf JLD/ GK
     699!IM: 211003 Ksta0.77      alb_new(1 : knon)  = 0.77
     700!IM: KstaTER0.8 & LMD_ARMIP5    alb_new(1 : knon)  = 0.8
     701!IM: KstaTER0.77 & LMD_ARMIP6   
     702        alb_new(1 : knon)  = 0.77
     703
    697704!
    698705! Rugosite
    … …  
    11441151
    11451152!IM cf. JP +++
    1146     albedo_keep(:) = (albedo_out(:,1)+albedo_out(:,2))/2.
     1153!IM BUG BUG BUG albedo_keep(:) = (albedo_out(:,1)+albedo_out(:,2))/2.
     1154    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
    11471155!IM cf. JP ---
    11481156
    … …  
    25992607! Masse maximum de neige (kg/m2). Au dessus de ce seuil, la neige
    26002608! en exces "s'ecoule" (calving)
    2601   real, parameter :: snow_max=1.
     2609!  real, parameter :: snow_max=1.
     2610!IM cf JLD/GK
     2611  real, parameter :: snow_max=3000.
    26022612  integer :: i
    26032613  real, dimension(klon) :: zx_mh, zx_nh, zx_oh
    … …  
    26142624! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
    26152625  REAL, parameter :: chasno = 3.334E+05/(2.3867E+06*0.15)
     2626!IM cf JLD/ GKtest
     2627  REAL, parameter :: chaice = 3.334E+05/(2.3867E+06*0.15)
     2628! fin GKtest
    26162629!
    26172630  logical, save         :: check = .FALSE.
    … …  
    27022715      tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 
    27032716!IM cf JLD OK     
    2704       IF (nisurf == is_sic .OR. nisurf == is_lic ) tsurf_new(i) = RTT
     2717!IM cf JLD/ GKtest fonte aussi pour la glace
     2718!      IF (nisurf == is_sic .OR. nisurf == is_lic ) tsurf_new(i) = RTT
     2719      IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
     2720        fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
     2721        ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
     2722        bil_eau_s(i) = bil_eau_s(i) + fq_fonte
     2723        tsurf_new(i) = RTT
     2724      ENDIF
     2725! fin GKtest
    27052726      d_ts(i) = tsurf_new(i) - tsurf(i)
    27062727!      zx_h_ts(i) = tsurf_new(i) * RCPD * zx_pkh(i)
    … …  
    27292750      run_off(i) = run_off(i) + MAX(qsol(i) - max_eau_sol, 0.0)
    27302751      qsol(i) = MIN(qsol(i), max_eau_sol)
    2731     else
    2732       run_off(i) = run_off(i) + MAX(bil_eau_s(i), 0.0)
     2752!IM : 0601003 else
     2753!IM: run_off(i) 
     2754!IM : 061003   run_off(i) = run_off(i) + MAX(bil_eau_s(i), 0.0)
    27332755    endif
    27342756  enddo

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

    r466 r486  
    281281c          write(6,'(a10)') 'ncol='
    282282c          write(6,'(8I10)') ncol
    283            write(6,'(a10)') 'top_height='
    284            write(6,'(8I10)') top_height
    285            write(6,'(a10)') 'overlap='
    286            write(6,'(8I10)') overlap
     283c          write(6,'(a10)') 'top_height='
     284c          write(6,'(8I10)') top_height
     285c          write(6,'(a10)') 'overlap='
     286c          write(6,'(8I10)') overlap
    287287c          write(6,'(a10)') 'emsfc_lw='
    288288c          write(6,'(8f10.2)') emsfc_lw
    … …  
    656656   
    657657          ! Reset threshold
    658 
    659 cIM pas besoin..memes val. de ran!     
    660 c         call ran0_vec(npoints,seed,ran)
     658          call ran0_vec(npoints,seed,ran)
    661659           
    662660          do j=1,npoints

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

    r418 r486  
    11      SUBROUTINE newmicro (paprs, pplay,ok_newmicro,
    22     .                  t, pqlwp, pclc, pcltau, pclemi,
    3      .                  pch, pcl, pcm, pct, pctlwp)
     3cIM    .                  pch, pcl, pcm, pct, pctlwp)
     4     .                  pch, pcl, pcm, pct, pctlwp,
     5     .                  xflwp, xfiwp, xflwc, xfiwc)
     6
    47      IMPLICIT none
    58c======================================================================
    … …  
    3639C
    3740      INTEGER i, k
    38       REAL zflwp, zradef, zfice, zmsac
     41cIM: 091003   REAL zflwp, zradef, zfice, zmsac
     42      REAL zflwp(klon), zradef, zfice, zmsac
     43cIM: 091003 rajout
     44      REAL xflwp(klon), xfiwp(klon)
     45      REAL xflwc(klon,klev), xfiwc(klon,klev)
    3946c
    4047      REAL radius, rad_chaud
    … …  
    5360      logical ok_newmicro
    5461c     parameter (ok_newmicro=.FALSE.)
    55       real rel, tc, rei, zfiwp
     62cIM: 091003   real rel, tc, rei, zfiwp
     63      real rel, tc, rei, zfiwp(klon)
    5664      real k_liq, k_ice0, k_ice, DF
    5765      parameter (k_liq=0.0903, k_ice0=0.005) ! units=m2/g
    … …  
    6270c Calculer l'epaisseur optique et l'emmissivite des nuages
    6371c
     72cIM inversion des DO
     73      DO i = 1, klon
     74       xflwp(i)=0.
     75       xfiwp(i)=0.
    6476      DO k = 1, klev
    65       DO i = 1, klon
     77c
     78       xflwc(i,k)=0.
     79       xfiwc(i,k)=0.
     80c
    6681         rad_chaud = rad_chau1
    6782         IF (k.LE.3) rad_chaud = rad_chau2
    6883         pclc(i,k) = MAX(pclc(i,k), seuil_neb)
    69          zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k)
     84         zflwp(i) = 1000.*pqlwp(i,k)/RG/pclc(i,k)
    7085     .          *(paprs(i,k)-paprs(i,k+1))
    7186         zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
    … …  
    7489         radius = rad_chaud * (1.-zfice) + rad_froid * zfice
    7590         coef = coef_chau * (1.-zfice) + coef_froi * zfice
    76          pcltau(i,k) = 3.0/2.0 * zflwp / radius
    77          pclemi(i,k) = 1.0 - EXP( - coef * zflwp)
     91         pcltau(i,k) = 3.0/2.0 * zflwp(i) / radius
     92         pclemi(i,k) = 1.0 - EXP( - coef * zflwp(i))
    7893
    7994         if (ok_newmicro) then
    … …  
    8499         zfice = MIN(MAX(zfice,0.0),1.0)
    85100
    86          zflwp = 1000.*(1.-zfice)*pqlwp(i,k)/pclc(i,k)
    87      :          *(paprs(i,k)-paprs(i,k+1))/RG
    88          zfiwp = 1000.*zfice*pqlwp(i,k)/pclc(i,k)
    89      :          *(paprs(i,k)-paprs(i,k+1))/RG
     101         zflwp(i) = 1000.*(1.-zfice)*pqlwp(i,k)/pclc(i,k)
     102     :          *(paprs(i,k)-paprs(i,k+1))/RG
     103         zfiwp(i) = 1000.*zfice*pqlwp(i,k)/pclc(i,k)
     104     :          *(paprs(i,k)-paprs(i,k+1))/RG
     105
     106         xflwp(i) = xflwp(i)+ (1.-zfice)*pqlwp(i,k)
     107     :          *(paprs(i,k)-paprs(i,k+1))/RG
     108         xfiwp(i) = xfiwp(i)+ zfice*pqlwp(i,k)
     109     :          *(paprs(i,k)-paprs(i,k+1))/RG
     110
     111cIM Total Liquid/Ice water content
     112         xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)
     113         xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)
     114cIM In-Cloud Liquid/Ice water content
     115c        xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)/pclc(i,k)
     116c        xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)/pclc(i,k)
    90117
    91118c -- effective cloud droplet radius (microns):
    … …  
    107134c  for ice clouds, Ebert & Curry (1992)]
    108135
    109          if (zflwp.eq.0.) rel = 1.
    110          if (zfiwp.eq.0. .or. rei.le.0.) rei = 1.
    111          pcltau(i,k) = 3.0/2.0 * ( zflwp/rel )
    112      .             + zfiwp * (3.448e-03  + 2.431/rei)
     136         if (zflwp(i).eq.0.) rel = 1.
     137         if (zfiwp(i).eq.0. .or. rei.le.0.) rei = 1.
     138         pcltau(i,k) = 3.0/2.0 * ( zflwp(i)/rel )
     139     .             + zfiwp(i) * (3.448e-03  + 2.431/rei)
    113140
    114141c -- cloud infrared emissivity:
    … …  
    121148
    122149         pclemi(i,k) = 1.0
    123      .      - EXP( - coef_chau*zflwp - DF*k_ice*zfiwp )
     150     .      - EXP( - coef_chau*zflwp(i) - DF*k_ice*zfiwp(i) )
    124151
    125152         endif ! ok_newmicro

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

    r467 r486  
    4040#include "mpiclim.h"
    4141c
    42 #include "oasis.h"      ! contains the name of communication technique. Here
     42#include "oasis.h"     
     43                        ! contains the name of communication technique. Here
    4344                        ! cchan=CLIM only is possible.
    4445c                       ! ctype=MPI2
    … …  
    554555      END
    555556
     557      SUBROUTINE halte
     558      print *, 'Attention dans oasis.F, halte est non defini'
     559      RETURN
     560      END
     561
     562      SUBROUTINE locread
     563      print *, 'Attention dans oasis.F, locread est non defini'
     564      RETURN
     565      END
     566
     567      SUBROUTINE locwrite
     568      print *, 'Attention dans oasis.F, locwrite est non defini'
     569      RETURN
     570      END
     571
    556572      SUBROUTINE pipe_model_define
    557573      print*,'Attention dans oasis.F, pipe_model_define est non defini'
    … …  
    574590      END
    575591
     592      SUBROUTINE clim_stepi
     593      print *, 'Attention dans oasis.F, clim_stepi est non defini'
     594      RETURN
     595      END
     596
     597      SUBROUTINE clim_start
     598      print *, 'Attention dans oasis.F, clim_start est non defini'
     599      RETURN
     600      END
     601
     602      SUBROUTINE clim_import
     603      print *, 'Attention dans oasis.F, clim_import est non defini'
     604      RETURN
     605      END
     606
     607      SUBROUTINE clim_export
     608      print *, 'Attention dans oasis.F, clim_export est non defini'
     609      RETURN
     610      END
     611
     612      SUBROUTINE clim_init
     613      print *, 'Attention dans oasis.F, clim_init est non defini'
     614      RETURN
     615      END
     616
     617      SUBROUTINE clim_define
     618      print *, 'Attention dans oasis.F, clim_define est non defini'
     619      RETURN
     620      END
     621
     622      SUBROUTINE clim_quit
     623      print *, 'Attention dans oasis.F, clim_quit est non defini'
     624      RETURN
     625      END
     626
     627      SUBROUTINE svipc_write
     628      print *, 'Attention dans oasis.F, svipc_write est non defini'
     629      RETURN
     630      END
     631
     632      SUBROUTINE svipc_close
     633      print *, 'Attention dans oasis.F, svipc_close est non defini'
     634      RETURN
     635      END
     636
     637      SUBROUTINE svipc_read
     638      print *, 'Attention dans oasis.F, svipc_read est non defini'
     639      RETURN
     640      END
     641
    576642      SUBROUTINE quitcpl
    577643      print *, 'Attention dans oasis.F, quitcpl est non defini'

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

    r478 r486  
    132132c      PARAMETER (ok_mensuel=.true.)
    133133c
     134      LOGICAL ok_mensuelNMC ! sortir le fichier mensuel niveaux NMC
     135      PARAMETER (ok_mensuelNMC=.true.)
     136c     save ok_mensuelNMC
     137c
    134138      LOGICAL ok_instan ! sortir le fichier instantane
    135139      save ok_instan
    … …  
    187191      REAL d_ps(klon)
    188192
    189 cccIM
    190       INTEGER klevp1
    191       PARAMETER(klevp1=klev+1)
     193      INTEGER klevp1, klevm1
     194      PARAMETER(klevp1=klev+1,klevm1=klev-1)
    192195#include "raddim.h"
    193 cc      REAL*8 ZFSUP(KDLON,KFLEV+1)
    194 cc      REAL*8 ZFSDN(KDLON,KFLEV+1)
    195 cc      REAL*8 ZFSUP0(KDLON,KFLEV+1)
    196 cc      REAL*8 ZFSDN0(KDLON,KFLEV+1)
    197196c
    198197      REAL swdn0(klon,2), swdn(klon,2), swup0(klon,2), swup(klon,2)
    199198      SAVE swdn0 , swdn, swup0, swup
    200199
    201 cccIM cf. FH
    202       real u850(klon),v850(klon),u200(klon),v200(klon)
    203       real u500(klon),v500(klon),phi500(klon),w500(klon)
    204 cIM
     200c vents meridien et zonal a un niveau de pression
     201      real u1000(klon), v1000(klon) !vents a 1000 hPa
     202      real u925(klon), v925(klon)   !vents a  925 hPa
     203      real u850(klon),v850(klon)    !vents a  850 hPa
     204      real u700(klon),v700(klon)
     205      real u600(klon),v600(klon)
     206      real u500(klon),v500(klon)
     207      real u400(klon),v400(klon)
     208      real u300(klon),v300(klon)
     209      real u250(klon),v250(klon)
     210      real u200(klon),v200(klon)
     211      real u150(klon),v150(klon)
     212      real u100(klon),v100(klon)
     213      real u70(klon),v70(klon)
     214      real u50(klon),v50(klon)
     215      real u30(klon),v30(klon)
     216      real u20(klon),v20(klon)
     217      real u10(klon),v10(klon)
     218      real phi500(klon),w500(klon)
     219c prw: precipitable water
    205220      real prw(klon)
    206221
    207 cIM ISCCP - proprietes microphysiques des nuages convectifs
    208222      REAL convliq(klon,klev)  ! eau liquide nuageuse convective
    209223      REAL convfra(klon,klev)  ! fraction nuageuse convective
    … …  
    214228      REAL cldt_s(klon),cldq_s(klon) !nuage total, eau liquide integree
    215229
    216       INTEGER kinv, linv
    217 
    218 cIM ISCCP simulator BEGIN
    219       INTEGER igfi2D(iim,jjmp1)
     230      INTEGER linv, kp1
     231c flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)
     232c flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
     233      REAL flwp(klon), fiwp(klon)
     234      REAL flwc(klon,klev), fiwc(klon,klev)
     235      REAL flwp_c(klon), fiwp_c(klon)
     236      REAL flwc_c(klon,klev), fiwc_c(klon,klev)
     237      REAL flwp_s(klon), fiwp_s(klon)
     238      REAL flwc_s(klon,klev), fiwc_s(klon,klev)
     239
     240c ISCCP simulator v3.4
     241c dans clesphys.h top_height, overlap
    220242cv3.4
    221243      INTEGER debug, debugcol
    222244      INTEGER npoints
    223245      PARAMETER(npoints=klon)
    224       INTEGER sunlit(klon)
    225 
     246c
     247      INTEGER sunlit(klon) !sunlit=1 if day; sunlit=0 if night
     248      INTEGER nregISCtot
     249      PARAMETER(nregISCtot=1)
     250c
     251c imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties sur 1 region rectangulaire
     252c y compris pour 1 point
     253c imin_debut : indice minimum de i; nbpti : nombre de points en direction i (longitude)
     254c jmin_debut : indice minimum de j; nbptj : nombre de points en direction j (latitude)
     255      INTEGER imin_debut, nbpti
     256      INTEGER jmin_debut, nbptj
     257c
     258      REAL nbsunlit(nregISCtot,klon)  !nbsunlit : moyenne de sunlit
    226259      INTEGER ncol, seed(klon)
    227260
    228 cIM dans clesphys.h top_height, overlap
     261c ncol = nb. de sous-colonnes pour chaque maille du GCM
    229262c     PARAMETER(ncol=100)
    230263c     PARAMETER(ncol=625)
    231       PARAMETER(ncol=10)
     264c     PARAMETER(ncol=10)
     265      PARAMETER(ncol=25)
    232266      REAL tautab(0:255)
    233267      INTEGER invtau(-20:45000)
    … …  
    235269      PARAMETER(emsfc_lw=0.99)
    236270      REAL    ran0                      ! type for random number fuction
    237 
     271c
     272      REAL cldtot(klon,klev)
     273c variables de haut en bas pour le simulateur ISCCP
     274      REAL dtau_s(klon,klev) !tau nuages startiformes
     275      REAL dtau_c(klon,klev) !tau nuages convectifs
     276      REAL dem_s(klon,klev)  !emissivite nuages startiformes
     277      REAL dem_c(klon,klev)  !emissivite nuages convectifs
     278c
     279c variables de haut en bas pour le simulateur ISCCP
    238280      REAL pfull(klon,klev)
    239281      REAL phalf(klon,klev+1)
    240       REAL cldtot(klon,klev)
    241       REAL dtau_s(klon,klev)
    242       REAL dtau_c(klon,klev)
    243       REAL dem_s(klon,klev)
    244       REAL dem_c(klon,klev)
    245 cPLUS : variables de haut en bas pour le simulateur ISCCP
    246282      REAL qv(klon,klev)
    247283      REAL cc(klon,klev)
    … …  
    253289      REAL dem_cH2B(klon,klev)
    254290
    255 c output from ISCCP
     291c output from ISCCP simulator
    256292      REAL fq_isccp(klon,7,7)
    257293      REAL totalcldarea(klon)
    … …  
    260296      REAL boxtau(klon,ncol)
    261297      REAL boxptop(klon,ncol)
    262 
    263 c grille 4d physique
    264       INTEGER l, ni, nj, kmax, lmax, nrec
    265       INTEGER ni1, ni2, nj1, nj2
    266 c     PARAMETER(kmax=7, lmax=7)
     298c
     299      INTEGER l, ni, nj, kmax, lmax
    267300      PARAMETER(kmax=8, lmax=8)
    268301      INTEGER kmaxm1, lmaxm1
    269302      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
    270 c     INTEGER iimx7, jjmx7, jjmp1x7
    271 c     PARAMETER(iimx7=iim*7, jjmx7=jjm*7, jjmp1x7=jjmp1*7)
    272 c     REAL fq4d(iim,jjmp1,7,7)
    273 c     REAL fq3d(iimx7, jjmp1x7)
    274       INTEGER iimx8, jjmx8, jjmp1x8
    275       PARAMETER(iimx8=iim*8, jjmx8=jjm*8, jjmp1x8=jjmp1*8)
    276       REAL fq4d(iim,jjmp1,8,8)
    277       REAL fq3d(iimx8, jjmp1x8)
    278 cIM180603     SAVE fq3d
    279 
    280 c     REAL maxfq3d, minfq3d
     303      INTEGER iimx7, jjmx7, jjmp1x7
     304      PARAMETER(iimx7=iim*kmaxm1, jjmx7=jjm*lmaxm1,
     305     .jjmp1x7=jjmp1*lmaxm1)
     306      REAL fq4d(iim,jjmp1,kmaxm1,lmaxm1)
     307      REAL fq3d(iimx7, jjmp1x7)
    281308c
    282309      INTEGER iw, iwmax
    … …  
    285312      PARAMETER(wmin=-200.,pas_w=10.,iwmax=40)
    286313      REAL o500(klon)
    287       INTEGER nreg, nbreg
    288       PARAMETER(nbreg=5)
    289 c     REAL histoW(iwmax,kmaxm1,lmaxm1)
    290       REAL histoW(kmaxm1,lmaxm1,iwmax,nbreg)
    291       REAL nhistoW(kmaxm1,lmaxm1,iwmax,nbreg)
    292 cIM180603     
    293 c     SAVE histoW, nhistoW
    294 c     SAVE nhistoW
    295       REAL nhistoWt(kmaxm1,lmaxm1,iwmax,nbreg)
     314c
     315cIM: nbregdyn = nbre regions pour calculs statistiques sur output du ISCCP
     316cIM: dynamiques 
     317      INTEGER nreg, nbregdyn
     318      PARAMETER(nbregdyn=5)
     319      REAL histoW(kmaxm1,lmaxm1,iwmax,nbregdyn)
     320      REAL nhistoW(kmaxm1,lmaxm1,iwmax,nbregdyn)
     321      REAL nhistoWt(kmaxm1,lmaxm1,iwmax,nbregdyn)
    296322      SAVE nhistoWt
    297323
    298 c     REAL histoWinv(kmaxm1,lmaxm1,iwmax)
    299 c     REAL nhistoW(kmaxm1,lmaxm1,iwmax)
    300       INTEGER linv
    301 c     LOGICAL pct_ocean(klon,nbreg)
    302       INTEGER pct_ocean(klon,nbreg)
     324      INTEGER pct_ocean(klon,nbregdyn)
    303325      REAL rlonPOS(klon)
    304 c     CHARACTER*4 pdirect
    305326 
    306327c sorties ISCCP
    … …  
    321342#endif
    322343
     344c sorties statistiques regime dynamique
     345      logical ok_regdyn
     346      real ecrit_regdyn
     347      integer nid_regdyn
     348      save ok_regdyn, ecrit_regdyn, nid_regdyn
     349
     350#undef histREGDYN
     351#define histREGDYN
     352#ifdef histREGDYN
     353c     data ok_regdyn,ecrit_regdyn/.true.,0.125/
     354c     data ok_regdyn,ecrit_regdyn/.true.,1./
     355       data ok_regdyn/.true./
     356#else
     357      data ok_regdyn/.false./
     358#endif
     359
    323360      REAL zx_tau(kmaxm1), zx_pc(lmaxm1), zx_o500(iwmax)
    324 c     DATA zx_tau/0.1, 1.3, 3.6, 9.4, 23., 60./
    325 c     DATA zx_pc/50., 180., 310., 440., 560., 680., 800., 1015./
    326 c     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
    327 cOK     DATA zx_tau/0.0, 0.1, 1.3, 3.6, 9.4, 23., 60./
    328 cOK     DATA zx_pc/800., 680., 560., 440., 310., 180., 50./
    329 
    330 c tester l'alure
    331       DATA zx_tau/1., 2., 3., 4., 5., 6., 7./
    332 c     DATA zx_pc/1., 2., 3., 4., 5., 6., 7./
    333       DATA zx_pc/7., 6., 5., 4., 3., 2., 1./
     361      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./
     362      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
     363
     364c cldtopres pression au sommet des nuages
     365      REAL cldtopres(lmaxm1)
     366      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
    334367
    335368      INTEGER komega, nhoriRD
    336369
    337 c statistiques regime dynamique END
    338 
    339 c     REAL del_lon(iim), del_lat(jjmp1)
    340       REAL del_lon, del_lat
    341 c     REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7)
    342       REAL zx_lonx8(iimx8), zx_latx8(jjmp1x8)
    343 c     INTEGER nhorix7
    344       INTEGER nhorix8
    345 
    346 cIM ISCCP simulator END
    347 
     370c taulev: numero du niveau de tau dans les sorties ISCCP
     371      CHARACTER *4 taulev(kmaxm1)
     372      DATA taulev/'tau1','tau2','tau3','tau4','tau5','tau6','tau7'/
     373
     374      REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7)
     375      INTEGER nhorix7
     376cIM: region='3d' <==> sorties en global
     377      CHARACTER*3 region
     378      PARAMETER(region='3d')
     379c
    348380      logical ok_hf
    349381      real ecrit_hf
    … …  
    513545      REAL yu1(klon)            ! vents dans la premiere couche U
    514546      REAL yv1(klon)            ! vents dans la premiere couche V
    515 cIM cf JLD
    516       REAL ffonte(klon,nbsrf)         !Flux thermique utilise pour fondre la neige
    517       REAL fqcalving(klon,nbsrf)      !Flux d'eau "perdue" par la surface
     547      REAL ffonte(klon,nbsrf)    !Flux thermique utilise pour fondre la neige
     548      REAL fqcalving(klon,nbsrf) !Flux d'eau "perdue" par la surface
    518549c                               !et necessaire pour limiter la
    519550c                               !hauteur de neige, en kg/m2/s
    … …  
    539570      REAL dlw(klon)    ! derivee infra rouge
    540571      REAL bils(klon) ! bilan de chaleur au sol
    541 cIM cf. JLD
    542572      REAL wfbils(klon,nbsrf) ! bilan de chaleur au sol, pour chaque
    543573C                   type de sous-surface et pondere par la fraction
    … …  
    574604      EXTERNAL angle     ! calculer angle zenithal du soleil
    575605      EXTERNAL alboc     ! calculer l'albedo sur ocean
    576       EXTERNAL albsno    ! calculer albedo sur neige
    577606      EXTERNAL ajsec     ! ajustement sec
    578607      EXTERNAL clmain    ! couche limite
    … …  
    601630      EXTERNAL ecrirega  ! ecrire le fichier binaire regional
    602631      EXTERNAL ecriregs  ! ecrire le fichier binaire regional
     632cIM
     633      EXTERNAL haut2bas  !variables de haut en bas
    603634c
    604635c Variables locales
    … …  
    685716      REAL cape(klon)           ! CAPE
    686717      SAVE cape
    687 cccIM
    688       CHARACTER*40 capemaxcels
     718      CHARACTER*40 capemaxcels  !max(CAPE)
    689719
    690720      REAL pbase(klon)          ! cloud base pressure
    … …  
    739769      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
    740770      REAL d_t_lif(klon,klev)
     771      REAL d_u_oli(klon,klev), d_v_oli(klon,klev) !tendances dues a oro et lif
    741772
    742773      REAL ratqs(klon,klev),ratqss(klon,klev),ratqsc(klon,klev)
    … …  
    792823c
    793824      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
    794       REAL zx_tmp_fi2d(klon)
     825      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
     826      REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
    795827      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
    796828      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
    797829c
    798       INTEGER nid_day, nid_mth, nid_ins
    799       SAVE nid_day, nid_mth, nid_ins
     830      INTEGER nid_day, nid_mth, nid_ins, nid_nmc
     831      SAVE nid_day, nid_mth, nid_ins, nid_nmc
    800832c
    801833      INTEGER nhori, nvert
    … …  
    841873      REAL ZRCPD
    842874c-jld ec_conser
    843 cIM
    844       REAL t2m(klon,nbsrf), q2m(klon,nbsrf)
    845       REAL u10m(klon,nbsrf), v10m(klon,nbsrf)
    846       REAL zt2m(klon), zq2m(klon)
    847       REAL zu10m(klon), zv10m(klon)
    848       CHARACTER*40 t2mincels, t2maxcels
     875cIM: t2m, q2m, u10m, v10m et t2mincels, t2maxcels
     876      REAL t2m(klon,nbsrf), q2m(klon,nbsrf)   !temperature, humidite a 2m
     877      REAL u10m(klon,nbsrf), v10m(klon,nbsrf) !vents a 10m
     878      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille
     879      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille
     880      CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
    849881c
    850882c Declaration des constantes et des fonctions thermodynamiques
    … …  
    10311063c   Initialisation des sorties
    10321064c=============================================================
     1065#ifdef histhf
     1066#include "ini_histhf.h"
     1067#endif
     1068
     1069#include "ini_histday.h"
     1070#include "ini_histmth.h"
     1071
     1072#undef histmthNMC
     1073#define histmthNMC
     1074#ifdef histmthNMC
     1075#include "ini_histmthNMC.h"
     1076#endif
     1077
     1078#include "ini_histins.h"
     1079
     1080#ifdef histREGDYN
     1081#include "ini_histREGDYN.h"
     1082#endif
    10331083
    10341084#ifdef histISCCP
    10351085#include "ini_histISCCP.h"
    10361086#endif
    1037 
    1038 #ifdef histhf
    1039 #include "ini_histhf.h"
    1040 #endif
    1041 
    1042 #include "ini_histday.h"
    1043 #include "ini_histmth.h"
    1044 #include "ini_histins.h"
    10451087
    10461088cXXXPB Positionner date0 pour initialisation de ORCHIDEE
    … …  
    12531295       sunlit(i)=1
    12541296       IF(rmu0(i).EQ.0.) sunlit(i)=0
    1255 c      IF(rmu0(i).EQ.0.) THEN
    1256 c       sunlit(i)=0
    1257 c       PRINT*,' il fait nuit ',i,rlat(i),rlon(i)
    1258 c      ENDIF
     1297       nbsunlit(1,i)=FLOAT(sunlit(i))
    12591298      ENDDO
    12601299cIM END
    … …  
    12891328     e            julien, rmu0, co2_ppm,
    12901329     e            ok_veget, ocean, npas, nexca, ftsol,
    1291      $            soil_model,cdmmax, cdhmax, ftsoil, qsol,
     1330     $            soil_model,cdmmax, cdhmax,
     1331     $            ksta, ksta_ter, ok_kzmin, ftsoil, qsol,
    12921332     $            paprs,pplay,radsol, fsnow,fqsurf,fevap,falbe,falblw,
    12931333     $            fluxlat,
    … …  
    17891829      enddo
    17901830
    1791 cIM ISCCP simulator BEGIN
     1831cIM calcul nuages par le simulateur ISCCP
    17921832      IF (ok_isccp) THEN
    17931833cIM calcul tau. emi nuages convectifs
    17941834      convfra(:,:)=rnebcon(:,:)
    17951835      convliq(:,:)=rnebcon(:,:)*clwcon(:,:)
    1796 c     CALL newmicro (paprs, pplay,ok_newmicro,
    1797 c    .            t_seri, cldliq, cldfra, cldtau, cldemi,
    1798 c    .            cldh, cldl, cldm, cldt, cldq)
    17991836      CALL newmicro (paprs, pplay,ok_newmicro,
    18001837     .            t_seri, convliq, convfra, dtau_c, dem_c,
    1801      .            cldh_c, cldl_c, cldm_c, cldt_c, cldq_c)
    1802 
     1838     .            cldh_c, cldl_c, cldm_c, cldt_c, cldq_c,
     1839     .            flwp_c, fiwp_c, flwc_c, fiwc_c)
     1840c
    18031841cIM calcul tau. emi nuages startiformes
    18041842      CALL newmicro (paprs, pplay,ok_newmicro,
    18051843     .            t_seri, cldliq, cldfra, dtau_s, dem_s,
    1806      .            cldh_s, cldl_s, cldm_s, cldt_s, cldq_s)
    1807 cIM calcul diagramme (PC, tau) cf. ISCCP D
    1808 c     seed=50
    1809 c     seed=ran0(klon)
    1810 cT1O3     
    1811 c     top_height=1
    1812 cT3O3
    1813 c     top_height=3
    1814 c     overlap=3
    1815 cIM cf GCM     
     1844     .            cldh_s, cldl_s, cldm_s, cldt_s, cldq_s,
     1845     .            flwp_s, fiwp_s, flwc_s, fiwc_s)
     1846c
    18161847      cldtot(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
    18171848
    18181849cIM inversion des niveaux de pression ==> de haut en bas
    1819       DO k=1,klev
    1820        kinv=klev-k+1
    1821        DO i=1,klon
    1822         pfull(i,k)=pplay(i,kinv)
    1823 c on met toutes les variables de Haut 2 Bas
    1824         qv(i,k)=q_seri(i,kinv)
    1825         cc(i,k)=cldtot(i,kinv)
    1826         conv(i,k)=rnebcon(i,kinv)
    1827         dtau_sH2B(i,k)=dtau_s(i,kinv)
    1828         dtau_cH2B(i,k)=dtau_c(i,kinv)
    1829         at(i,k)=t_seri(i,kinv)
    1830         dem_sH2B(i,k)=dem_s(i,kinv)
    1831         dem_cH2B(i,k)=dem_c(i,kinv)
    1832 
    1833        ENDDO
    1834       ENDDO
    1835 
    1836       DO k=1,klev+1
    1837        kinv=klev-k+2
    1838        DO i=1,klon
    1839         phalf(i,k)=paprs(i,kinv)
    1840        ENDDO
    1841       ENDDO
     1850      CALL haut2bas(klon, klev, pplay, pfull)
     1851      CALL haut2bas(klon, klev, q_seri, qv)
     1852      CALL haut2bas(klon, klev, cldtot, cc)
     1853      CALL haut2bas(klon, klev, rnebcon, conv)
     1854      CALL haut2bas(klon, klev, dtau_s, dtau_sH2B)
     1855      CALL haut2bas(klon, klev, dtau_c, dtau_cH2B)
     1856      CALL haut2bas(klon, klev, t_seri, at)
     1857      CALL haut2bas(klon, klev, dem_s, dem_sH2B)
     1858      CALL haut2bas(klon, klev, dem_c, dem_cH2B)
     1859      CALL haut2bas(klon, klevp1, paprs, phalf)
    18421860
    18431861c     open(99,file='tautab.bin',access='sequential',
    … …  
    18551873      close(99)
    18561874c
     1875cIM: calcul coordonnees regions pour statistiques distribution
     1876cIM: nuages en ftion du regime dynamique pour regions oceaniques
     1877       IF (ok_regdyn) THEN !histREGDYN
    18571878       nsrf=3
    1858        DO nreg=1, nbreg
     1879       DO nreg=1, nbregdyn
    18591880       DO i=1, klon
    18601881
    … …  
    18671888c       ENDIF
    18681889
    1869 c       pct_ocean(i,nreg)=.FALSE.
    18701890        pct_ocean(i,nreg)=0
    1871 
    1872 c      DO nsrf = 1, nbsrf
    18731891
    18741892c test si c'est 1 point d'ocean
    … …  
    18791897c TROP
    18801898          IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
    1881 c          pct_ocean(i,nreg)=.TRUE.
    18821899           pct_ocean(i,nreg)=1
    18831900          ENDIF
    … …  
    18871904           IF(rlat(i).GE.40.AND.rlat(i).LE.60.) THEN
    18881905            IF(rlonPOS(i).GE.160..AND.rlonPOS(i).LE.235.) THEN
    1889 c            pct_ocean(i,nreg)=.TRUE.
    18901906             pct_ocean(i,nreg)=1
    18911907            ENDIF
    … …  
    18951911          IF(rlonPOS(i).GE.220..AND.rlonPOS(i).LE.250.) THEN
    18961912           IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
    1897 c           pct_ocean(i,nreg)=.TRUE.
    18981913            pct_ocean(i,nreg)=1
    18991914           ENDIF
    … …  
    19031918         IF(rlonPOS(i).GE.180..AND.rlonPOS(i).LE.220.) THEN
    19041919          IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN
    1905 c          pct_ocean(i,nreg)=.TRUE.
    19061920           pct_ocean(i,nreg)=1
    19071921          ENDIF
    … …  
    19111925         IF(rlonPOS(i).GE.70..AND.rlonPOS(i).LE.150.) THEN
    19121926          IF(rlat(i).GE.-5.AND.rlat(i).LE.20.) THEN
    1913 c          pct_ocean(i,nreg)=.TRUE.
    19141927           pct_ocean(i,nreg)=1
    19151928          ENDIF
    19161929         ENDIF
    1917         ENDIF !nbreg
     1930        ENDIF !nbregdyn
    19181931c TROP
    19191932c        IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN
    … …  
    19241937
    19251938        ENDIF !pctsrf
    1926 c      ENDDO
    19271939       ENDDO !klon
    1928        ENDDO !nbreg
     1940       ENDDO !nbregdyn
     1941       ENDIF !ok_regdyn
    19291942 
    19301943cIM somme de toutes les nhistoW BEG
    1931       DO nreg = 1, nbreg
    1932       DO k = 1, kmaxm1
    1933       DO l = 1, lmaxm1
    1934       DO iw = 1, iwmax
    1935        nhistoWt(k,l,iw,nreg)=0.
    1936       ENDDO
    1937       ENDDO
    1938       ENDDO
    1939       ENDDO
     1944      DO nreg = 1, nbregdyn
     1945       DO k = 1, kmaxm1
     1946        DO l = 1, lmaxm1
     1947         DO iw = 1, iwmax
     1948          nhistoWt(k,l,iw,nreg)=0.
     1949         ENDDO !iw
     1950        ENDDO !l
     1951       ENDDO !k
     1952      ENDDO !nreg
    19401953cIM somme de toutes les nhistoW END
    1941       ENDIF
    1942 
    1943 
    1944 c     CALL ISCCP_CLOUD_TYPES(nlev,ncol,seed,pfull,phalf,qv,
    1945 c    &     cc,conv,dtau_s,dtau_c,top_height,overlap,
    1946 c    &     tautab,invtau,skt,emsfc_lw,at,dem_s,dem_c,fq_isccp,
    1947 c    &     totalcldarea,meanptop,meantaucld,boxtau,boxptop)
    1948 
    1949 c     DO i=1, klon
    1950 c     i=1
    1951 c1011  CONTINUE
    1952 c
    1953 cIM on verifie les donnees de INPUT en dehors du simulateur ISCCP
    1954 cIM 1D non-vectorise (!) pour qu'on gagne du temps ...
    1955 cIM
    1956 c BEGIN find unpermittable data.....
    1957 !     ---------------------------------------------------!
    1958 !     find unpermittable data.....
    1959 !
    1960 c     do 13 k=1,klev
    1961 c ca prend trop de temps ??
    1962 c     cldtot(:,:) = min(max(cldtot(:,:),0.),1.)
    1963 c     rnebcon(:,:) = min(max(rnebcon(:,:),0.),1.)
    1964 c     dtau_s(:,:) = max(dtau_s(:,:),0.)
    1965 c     dem_s(:,:) = min(max(dem_s(:,:),0.),1.)
    1966 c     dtau_c(:,:) = max(dtau_c(:,:),0.)
    1967 c     dem_c(:,:) = min(max(dem_c(:,:),0.),1.)
    1968 c ca prend trop de temps ??
    1969 
    1970 c           if (cldtot(i,k) .lt. 0.) then
    1971 c               print *, ' error = cloud fraction less than zero'
    1972 c               STOP
    1973 c           end if
    1974 c           if (cldtot(i,k) .gt. 1.) then
    1975 c               print *, ' error = cloud fraction greater than 1'
    1976 c               STOP
    1977 c           end if
    1978 c           if (rnebcon(i,k) .lt. 0.) then
    1979 c               print *,
    1980 c    &           ' error = convective cloud fraction less than zero'
    1981 c               STOP
    1982 c           end if
    1983 c           if (rnebcon(i,k) .gt. 1.) then
    1984 c               print *,
    1985 c    &           ' error = convective cloud fraction greater than 1'
    1986 c               STOP
    1987 c           end if
    1988 
    1989 c           if (dtau_s(i,k) .lt. 0.) then
    1990 c               print *,
    1991 c    &           ' error = stratiform cloud opt. depth less than zero'
    1992 c               STOP
    1993 c           end if
    1994 c           if (dem_s(i,k) .lt. 0.) then
    1995 c               print *,
    1996 c    &           ' error = stratiform cloud emissivity less than zero'
    1997 c               STOP
    1998 c           end if
    1999 c           if (dem_s(i,k) .gt. 1.) then
    2000 c               print *,
    2001 c    &           ' error = stratiform cloud emissivity greater than 1'
    2002 c               STOP
    2003 c           end if
    2004 
    2005 c           if (dtau_c(i,k) .lt. 0.) then
    2006 c               print *,
    2007 c    &           ' error = convective cloud opt. depth less than zero'
    2008 c               STOP
    2009 c           end if
    2010 c           if (dem_c(i,k) .lt. 0.) then
    2011 c               print *,
    2012 c    &           ' error = convective cloud emissivity less than zero'
    2013 c               STOP
    2014 c           end if
    2015 c           if (dem_c(i,k) .gt. 1.) then
    2016 c               print *,
    2017 c    &           ' error = convective cloud emissivity greater than 1'
    2018 c               STOP
    2019 c           end if
    2020 c13    continue
    2021 
    2022 !     ---------------------------------------------------!
    2023 c
    2024 c END   find unpermittable data.....
    2025 cv2.2.1.1     DO i=1, klon
    2026 c     i=1
    2027 c     seed=i
    2028 c
    2029 cv3.4
    2030       if (debut) then
     1954c
     1955cIM: initialisation de seed
    20311956        DO i=1, klon
    20321957          seed(i)=i+100
    2033 c         seed(i)=i+50
    20341958        ENDDO
    2035       endif
    2036 c     seed=aint(ran0(klon))
    2037 c     CALL ISCCP_CLOUD_TYPES(klev,ncol,seed,pfull(i,:),phalf(i,:)
    2038 cv2.2.1.1
    2039 c     CALL ISCCP_CLOUD_TYPES(klev,ncol,seed(i),pfull(i,:),phalf(i,:)
    2040 c    &     ,q_seri(i,:),
    2041 c    &     cldtot(i,:),rnebcon(i,:),dtau_s(i,:),dtau_c(i,:),
    2042 c    &     top_height,overlap,
    2043 c    &     tautab,invtau,ztsol,emsfc_lw,t_seri(i,:),dem_s(i,:),
    2044 c    &     dem_c(i,:),
    2045 c    &     fq_isccp(i,:,:),
    2046 c    &     totalcldarea(i),meanptop(i),meantaucld(i),
    2047 c    &     boxtau(i,:),boxptop(i,:))
    2048 cv2.2.1.1
    2049 cv3.4
     1959      ENDIF !debut
     1960cIM: pas de debug, debugcol
    20501961      debug=0
    20511962      debugcol=0
    20521963cIM260503
    2053 c o500 ==> distribution nuage ftion du regime dynamique
    2054       DO i=1, klon
    2055        o500(i)=omega(i,8)*864.
    2056 c      PRINT*,'pphi8 ',pphi(i,8),'zphi8,11,12',zphi(i,8),
    2057 c    & zphi(i,11),zphi(i,12)
    2058       ENDDO
    2059 
    2060 c axe vertical pour les differents niveaux des histogrammes
    2061 c     DO iw=1, iwmax
    2062 c       zx_o500(iw)=wmin+(iw-1./2.)*pas_w
    2063 c     ENDDO
    2064 c     PRINT*,' phys AVANT seed(3361)=',seed(3361)
     1964c o500 ==> distribution nuage ftion du regime dynamique a 500 hPa
     1965        DO k=1, klevm1
     1966        kp1=k+1
     1967c       PRINT*,'k, presnivs',k,presnivs(k), presnivs(kp1)
     1968        if(presnivs(k).GT.50000.AND.presnivs(kp1).LT.50000.) THEN
     1969         DO i=1, klon
     1970          o500(i)=omega(i,k)*RDAY/100.
     1971c         if(i.EQ.1) print*,' 500hPa lev',k,presnivs(k),presnivs(kp1)
     1972         ENDDO
     1973         GOTO 1000
     1974        endif
     19751000  continue
     1976      ENDDO
     1977
    20651978      CALL ISCCP_CLOUD_TYPES(
    20661979     &     debug,
    … …  
    20731986     &     pfull,
    20741987     &     phalf,
    2075 c var de bas en haut ==> PB !
    2076 c    &     q_seri,
    2077 c    &     cldtot,
    2078 c    &     rnebcon,
    2079 c    &     dtau_s,
    2080 c    &     dtau_c,
    2081 c var de Haut en Bas BEG
    20821988     &     qv, cc, conv, dtau_sH2B, dtau_cH2B,
    2083 c var de Haut en Bas END
    20841989     &     top_height,
    20851990     &     overlap,
    … …  
    20881993     &     ztsol,
    20891994     &     emsfc_lw,
    2090 c var de bas en haut ==> PB !
    2091 c    &     t_seri,
    2092 c    &     dem_s,
    2093 c    &     dem_c,
    2094 c var de Haut en Bas BEG
    20951995     &     at, dem_sH2B, dem_cH2B,
    2096 cIM260503
    2097 c    &     o500, pct_ocean,
    2098 c var de Haut en Bas END
    20991996     &     fq_isccp,
    21001997     &     totalcldarea,
    … …  
    21032000     &     boxtau,
    21042001     &     boxptop)
    2105 c    &     boxptop,
    2106 cIM 260503
    2107 c    &     histoW,
    2108 c    &     nhistoW   
    2109 c    &)
    2110 
    2111 cIM 200603
    2112 c     PRINT*,'physiq fq_isccp(6,1,1)',fq_isccp(6,1,1)
    2113        
    2114 cIM 200603
    2115 cIM somme de toutes les nhistoW BEG
    2116 c     DO k = 1, kmaxm1
    2117 c     DO l = 1, lmaxm1
    2118 c     DO iw = 1, iwmax
    2119 c     nhistoWt(k,l,iw)=nhistoWt(k,l,iw)+nhistoW(k,l,iw)
    2120 ccc      IF(k.EQ.1.AND.l.EQ.1.AND.iw.EQ.1) then
    2121 c      IF(nhistoWt(k,l,iw).NE.0.) THEN
    2122 c       PRINT*,' physiq nWt', k,l,iw,nhistoWt(k,l,iw)
    2123 c      ENDIF
    2124 c     ENDDO
    2125 c     ENDDO
    2126 c     ENDDO
    2127 cIM somme de toutes les nhistoW END
    2128 c     PRINT*,' phys APRES seed(3361)=',seed(3361)
    2129 cv3.4
    2130 c     i=i+1
    2131 c     IF(i.LE.klon) THEN
    2132 c      GOTO 1011
    2133 c     ENDIF
    2134 cv2.2.1.1     ENDDO
     2002
    21352003
    21362004c passage de la grille (klon,7,7) a (iim,jjmp1,7,7)
    2137 c     minfq3d=100.
    2138 c     maxfq3d=0.
    2139 cIM calcul des correspondances entre la grille physique et
    2140 cIM la grille dynamique
    2141 c     DO i=1, klon
    2142 c       grid_phys(i)=i
    2143 c       PRINT*,'i, grid_phys',i,grid_phys(i)
    2144 c     ENDDO
    2145 c     CALL gr_fi_dyn(1,klon,iimp1,jjmp1,grid_phys,grid_dyn)
    2146 c     DO j=1, jjmp1
    2147 c       DO i=1, iimp1
    2148 c        PRINT*,'i,j grid_dyn ',i,j,grid_dyn(i,j)
    2149 c       ENDDO
    2150 c     ENDDO
    2151 c
    2152       DO l=1, lmax
    2153        DO k=1, kmax
    2154 cIM grille physique ==> grille ecriture 2D (iim,jjmp1)
    2155 c
     2005      DO l=1, lmaxm1
     2006       DO k=1, kmaxm1
    21562007        DO i=1, iim
    2157           fq4d(i,1,k,l)=fq_isccp(1,k,l)
    2158 cc         PRINT*,'first j=1 i =',i
     2008         fq4d(i,1,k,l)=fq_isccp(1,k,l)
    21592009        ENDDO
    21602010        DO j=2, jjm
    2161           DO i=1, iim
    2162 cERROR ??         ig=i+iim*(j-1)
     2011         DO i=1, iim
    21632012          ig=i+1+(j-2)*iim
    2164 cc         PRINT*,'i =',i,'j =',j,'ig=',ig
    21652013          fq4d(i,j,k,l)=fq_isccp(ig,k,l)             
    21662014         ENDDO
    21672015        ENDDO
    21682016        DO i=1, iim
    2169           fq4d(i,jjmp1,k,l)=fq_isccp(klon,k,l)
    2170 cc         PRINT*,'last jjmp1 i =',i
     2017         fq4d(i,jjmp1,k,l)=fq_isccp(klon,k,l)
    21712018        ENDDO
    2172         IF(debut) THEN
    2173         DO j=1, jjmp1
    2174           DO i=1, iim
    2175             IF(j.GE.2.AND.j.LE.jjm) THEN
    2176               igfi2D(i,j)=i+1+(j-2)*iim
    2177 c             PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)
    2178             ELSEIF(j.EQ.1) THEN
    2179               igfi2D(i,j)=1
    2180 c             PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)
    2181             ELSEIF(j.EQ.jjmp1) THEN
    2182               igfi2D(i,j)=klon
    2183 c             PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)
    2184             ENDIF
    2185           ENDDO
    2186         ENDDO
    2187         ENDIF
    2188 c       STOP
    2189 c
    2190 c       CALL gr_fi_ecrit(1,klon,iim,jjmp1,fq_isccp(:,k,l),
    2191 c    $       fq4d(:,:,k,l))
    21922019       ENDDO
    21932020      ENDDO
    2194       DO l=1, lmax
    2195        fq4d(:,:,8,l)=-1.e+10
    2196        fq4d(:,:,l,8)=-1.e+10
    2197       ENDDO
    2198       DO l=1, lmax
    2199        DO k=1, kmax 
     2021c
     2022      DO l=1, lmaxm1
     2023       DO k=1, kmaxm1 
    22002024        DO j=1, jjmp1
    22012025         DO i=1, iim
    2202 
    2203 c inversion TAU ?!
    2204 c         ni=(i-1)*lmax+l
    2205 c         nj=(j-1)*kmax+kmax-k+1
    2206 c
    2207 c210503 inversion en PC ==> pas besoin !!!
    2208 c         ni=(i-1)*lmax+lmax-l+1
    2209 c         nj=(j-1)*kmax+k
    2210 c
    2211 c210503
    2212           ni=(i-1)*lmax+l
    2213           nj=(j-1)*kmax+k
    2214  
    2215 c210503         if(k.EQ.8) then
    2216 c          fq4d(i,j,8,l)=-1.e+10
    2217 c         endif
    2218 
    2219 c210503         if(l.EQ.8) then
    2220 c          fq4d(i,j,k,8)=-1.e+10
    2221 c         endif
    2222 
    2223           fq3d(ni,nj)=fq4d(i,j,k,l)
    2224 
    2225 c         if(fq3d(ni,nj).lt.0.) then
    2226 c          print*,' fq3d LT ZERO ',ni,nj,fq3d(ni,nj)
    2227 c         endif
    2228 c         if(fq3d(ni,nj).gt.100.) then
    2229 c          print*,' fq3d GT 100 ',ni,nj,fq3d(ni,nj)
    2230 c         endif
    2231 c max & min fq3d
    2232 c         if(fq3d(ni,nj).gt.maxfq3d) maxfq3d=fq3d(ni,nj)
    2233 c         if(fq3d(ni,nj).lt.minfq3d) minfq3d=fq3d(ni,nj)
    2234          
     2026           ni=(i-1)*lmaxm1+l
     2027           nj=(j-1)*kmaxm1+k
     2028           fq3d(ni,nj)=fq4d(i,j,k,l)
    22352029         ENDDO
    22362030        ENDDO
    2237 c       fq4d(:,:,8,l)=-1.e+10
    2238 c       fq4d(:,:,k,8)=-1.e+10
    2239 c       k=k+1
    2240 c       if(k.LE.kmax) then
    2241 c        goto 1022
    2242 c       endif
    22432031       ENDDO
    2244 c      l=l+1
    2245 c      if(l.LE.lmax) then
    2246 c       goto 1021
    2247 c      endif
    2248       ENDDO
    2249 
    2250 c     print*,' minfq3d=',minfq3d,' maxfq3d=',maxfq3d
     2032      ENDDO
     2033
    22512034c
    22522035c calculs statistiques distribution nuage ftion du regime dynamique
    2253 c     DO i=1, klon
    2254 c!      o500(i)=omega(i,9)*864.
    2255 c!      PRINT*,' o500=',o500(i),' pphi(9)=',pphi(i,9)
    2256 c       o500(i)=omega(i,8)*864.
    2257 cc      PRINT*,' pphi(8)',pphi(i,8),'pphi(11)',pphi(i,11),
    2258 cc    .'pphi(12)',pphi(i,12)
    2259 cc      PRINT*,' zphi8,11,12=',zphi(i,8),zphi(i,11),zphi(i,12)
    2260 cc     PRINT*,' o500',o500(i),' w500',w500(i)
    2261 c     ENDDO
    2262 
    2263 c axe vertical pour les differents niveaux des histogrammes
    2264 c     DO iw=1, iwmax
    2265 c       zx_o500(iw)=wmin+(iw-1./2.)*pas_w
    2266 c     ENDDO
    2267 
    2268 
     2036c
    22692037c Ce calcul doit etre fait a partir de valeurs mensuelles ??
    2270 cc     CALL histo_o500_pctau(o500,fq4d,histoW)
    2271 cc     CALL histo_o500_pctau(paire,pctsrf,o500,fq4d,histoW)
    2272 cc     CALL histo_o500_pctau(pct_ocean,rlat,o500,fq4d,histoW)
    2273 ccOK ???     CALL histo_o500_pctau(pct_ocean,o500,fq4d,histoW)
    2274 c     CALL histo_o500_pctau(klon,pct_ocean,o500,fq4d,histoW,nhistoW)
    2275 c     CALL histo_o500_pctau(klon,pct_ocean,o500,fq_isccp,
    2276       CALL histo_o500_pctau(nbreg,pct_ocean,o500,fq_isccp,
     2038      CALL histo_o500_pctau(nbregdyn,pct_ocean,o500,fq_isccp,
    22772039     &histoW,nhistoW)
    22782040c
    2279 cIM somme de toutes les nhistoW BEG
    2280       DO nreg=1, nbreg
    2281       DO k = 1, kmaxm1
    2282       DO l = 1, lmaxm1
    2283       DO iw = 1, iwmax
    2284        nhistoWt(k,l,iw,nreg)=nhistoWt(k,l,iw,nreg)+
    2285      & nhistoW(k,l,iw,nreg)
    2286 ccc      IF(k.EQ.1.AND.l.EQ.1.AND.iw.EQ.1) then
    2287 c      IF(nhistoWt(k,l,iw).NE.0.) THEN
    2288 c       PRINT*,' physiq nWt', k,l,iw,nhistoWt(k,l,iw)
    2289 c      ENDIF
    2290       ENDDO
    2291       ENDDO
    2292       ENDDO
    2293       ENDDO
    2294 cIM somme de toutes les nhistoW END
    2295 c
    2296 c     IF(lafin) THEN   
    2297 c     DO nreg=1, nbreg
    2298 c     DO iw=1, iwmax
    2299 c     DO l=1,lmaxm1
    2300 c     DO k=1,kmaxm1
    2301 c      IF(histoW(k,l,iw,nreg).NE.0.) then
    2302 c        PRINT*,'physiq H nH',k,l,iw,
    2303 c    &       histoW(k,l,iw,nreg),
    2304 c    &       nhistoW(k,l,iw,nreg),nhistoWt(k,l,iw,nreg)
    2305 c      ENDIF
    2306 c     ENDDO
    2307 c     ENDDO
    2308 c     ENDDO
    2309 c     ENDDO
    2310 cIM verif fq_isccp, fq4d, fq3d
    2311 c     DO l=1, lmaxm1
    2312 c       DO k=1,kmaxm1
    2313 c     i=74
    2314 c     j=36
    2315 c     DO j=1, jjmp1
    2316 c      DO i=1, iim
    2317 c       DO l=1, lmaxm1
    2318 c         WRITE(*,'(a,3i4,7f10.4)')
    2319 c    &    'fq_isccp,j,i,l=',j,i,l,
    2320 c    &    (fq_isccp(igfi2D(i,j),k,l),k=1,kmaxm1)
    2321 c         WRITE(*,'(a,3i4,7f10.4)')
    2322 c    &    'fq4d,j,i,l=',j,i,l,(fq4d(i,j,k,l),k=1,kmaxm1)
    2323 c       ENDDO
    2324 c      ENDDO
    2325 c     ENDDO
    2326 c     ni1=(i-1)*8+1
    2327 c     ni2=i*8
    2328 c     nj1=(j-1)*8+1
    2329 c     nj2=j*8
    2330 c     DO ni=ni1,ni2
    2331 c     WRITE(*,'(a,2i4,7f10.4)')
    2332 c    &     'fq3d, ni,nj=',ni,nj,
    2333 c    &      (fq3d(ni,nj),nj=nj1,nj2)
    2334 c     ENDDO
    2335 c     ENDIF
    2336 
    2337 c     DO iw=1, iwmax
    2338 c      DO l=1,lmaxm1
    2339 c       DO k=1,kmaxm1
    2340 c        PRINT*,' iw,l,k,nhistoW=',iw,l,k,nhistoW(k,l,iw)
    2341 c       ENDDO
    2342 c      ENDDO
    2343 c     ENDDO
    2344 
    2345 c       DO iw=1, iwmax
    2346 c        DO l=1, lmaxm1
    2347 c         linv=lmaxm1-l+1
    2348 c         DO k=1, kmaxm1
    2349 c         histoWinv(k,l,iw)=histoW(iw,k,l)
    2350 c       ENDDO
    2351 c      ENDDO
    2352 c     ENDDO
    2353 c
    2354 c pb syncronisation ?? : 48 * 30 * 7 (jour1) + 48* 29 * 7 (jour suivant)
    2355 c
    2356 
    2357 
     2041c nhistoWt = somme de toutes les nhistoW
     2042      DO nreg=1, nbregdyn
     2043       DO k = 1, kmaxm1
     2044        DO l = 1, lmaxm1
     2045         DO iw = 1, iwmax
     2046          nhistoWt(k,l,iw,nreg)=nhistoWt(k,l,iw,nreg)+
     2047     &    nhistoW(k,l,iw,nreg)
     2048         ENDDO
     2049        ENDDO
     2050       ENDDO
     2051      ENDDO
     2052c
    23582053      ENDIF !ok_isccp
    2359 cIM ISCCP simulator END
    23602054
    23612055c   On prend la somme des fractions nuageuses et des contenus en eau
    … …  
    23632057      cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
    23642058
    2365 
    23662059      ENDIF
     2060
    23672061c
    23682062c 2. NUAGES STARTIFORMES
    … …  
    24232117      CALL newmicro (paprs, pplay,ok_newmicro,
    24242118     .            t_seri, cldliq, cldfra, cldtau, cldemi,
    2425      .            cldh, cldl, cldm, cldt, cldq)
     2119     .            cldh, cldl, cldm, cldt, cldq,
     2120     .            flwp, fiwp, flwc, fiwc)
    24262121      else
    24272122      CALL nuage (paprs, pplay,
    … …  
    24502145!      albsollw = albsollw1
    24512146      CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
    2452 cIM  e            (dist, rmu0, fract, co2_ppm, solaire,
    24532147     e            (dist, rmu0, fract,
    24542148     e             paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri,
    … …  
    24582152     s             topsw,toplw,solsw,sollw,
    24592153     s             sollwdown,
    2460 cccIMs             topsw0,toplw0,solsw0,sollw0)
    24612154     s             topsw0,toplw0,solsw0,sollw0,
    24622155     s             swdn0, swdn, swup0, swup     )
    … …  
    26582351     s                   ve, vq, ue, uq)
    26592352c
     2353c
    26602354c Accumuler les variables a stocker dans les fichiers histoire:
    26612355c
    … …  
    26922386      END IF
    26932387C
    2694 cccIM cf. FH
    26952388c=======================================================================
    26962389c   SORTIES
    … …  
    26992392c   Interpollation sur quelques niveaux de pression
    27002393c   -----------------------------------------------
    2701 
     2394c
     2395cIM sorties sur les 17 niveaux de pression du NMC
     2396c 1000 hPa
     2397      call plevel(klon,klev,.true. ,pplay,100000.,u_seri,u1000)
     2398      call plevel(klon,klev,.false.,pplay,100000.,v_seri,v1000)
     2399c 925 hPa
     2400      call plevel(klon,klev,.true. ,pplay,92500.,u_seri,u925)
     2401      call plevel(klon,klev,.false.,pplay,92500.,v_seri,v925)
     2402c 850 hPa
    27022403      call plevel(klon,klev,.true. ,pplay,85000.,u_seri,u850)
    27032404      call plevel(klon,klev,.false.,pplay,85000.,v_seri,v850)
     2405c 700 hPa
     2406      call plevel(klon,klev,.true. ,pplay,70000.,u_seri,u700)
     2407      call plevel(klon,klev,.false.,pplay,70000.,v_seri,v700)
     2408c 600 hPa
     2409      call plevel(klon,klev,.true. ,pplay,60000.,u_seri,u600)
     2410      call plevel(klon,klev,.false.,pplay,60000.,v_seri,v600)
     2411c 500 hPa
    27042412      call plevel(klon,klev,.true. ,pplay,50000.,u_seri,u500)
    27052413      call plevel(klon,klev,.false.,pplay,50000.,v_seri,v500)
     2414c 400 hPa
     2415      call plevel(klon,klev,.true. ,pplay,40000.,u_seri,u400)
     2416      call plevel(klon,klev,.false.,pplay,40000.,v_seri,v400)
     2417c 300 hPa
     2418      call plevel(klon,klev,.true. ,pplay,30000.,u_seri,u300)
     2419      call plevel(klon,klev,.false.,pplay,30000.,v_seri,v300)
     2420c 250 hPa
     2421      call plevel(klon,klev,.true. ,pplay,25000.,u_seri,u250)
     2422      call plevel(klon,klev,.false.,pplay,25000.,v_seri,v250)
     2423c 200 hPa
    27062424      call plevel(klon,klev,.true. ,pplay,20000.,u_seri,u200)
    27072425      call plevel(klon,klev,.false.,pplay,20000.,v_seri,v200)
     2426c 150 hPa
     2427      call plevel(klon,klev,.true. ,pplay,15000.,u_seri,u150)
     2428      call plevel(klon,klev,.false.,pplay,15000.,v_seri,v150)
     2429c 100 hPa
     2430      call plevel(klon,klev,.true. ,pplay,10000.,u_seri,u100)
     2431      call plevel(klon,klev,.false.,pplay,10000.,v_seri,v100)
     2432c 70 hPa
     2433      call plevel(klon,klev,.true. ,pplay,7000.,u_seri,u70)
     2434      call plevel(klon,klev,.false.,pplay,7000.,v_seri,v70)
     2435c 50 hPa
     2436      call plevel(klon,klev,.true. ,pplay,5000.,u_seri,u50)
     2437      call plevel(klon,klev,.false.,pplay,5000.,v_seri,v50)
     2438c 30 hPa
     2439      call plevel(klon,klev,.true. ,pplay,3000.,u_seri,u30)
     2440      call plevel(klon,klev,.false.,pplay,3000.,v_seri,v30)
     2441c 20 hPa
     2442      call plevel(klon,klev,.true. ,pplay,2000.,u_seri,u20)
     2443      call plevel(klon,klev,.false.,pplay,2000.,v_seri,v20)
     2444c 10 hPa
     2445      call plevel(klon,klev,.true. ,pplay,1000.,u_seri,u10)
     2446      call plevel(klon,klev,.false.,pplay,1000.,v_seri,v10)
     2447c
    27082448      call plevel(klon,klev,.true. ,pplay,50000.,zphi,phi500)
    27092449      call plevel(klon,klev,.true. ,paprs,50000.,omega,w500)
    2710 
    2711 cIM cf. FH     slp(:) = paprs(:,1)*exp(pphis(:)/(289.*t_seri(:,1)))
     2450c slp sea level pressure
    27122451      slp(:) = paprs(:,1)*exp(pphis(:)/(RD*t_seri(:,1)))
    2713 c     PRINT*,' physiq slp ',slp(2185),paprs(2185,1),pphis(2185),
    2714 c    .       RD,t_seri(2185,1)
    27152452c
    27162453ccc prw = eau precipitable
    27172454      DO i = 1, klon
    27182455       prw(i) = 0.
     2456       DO k = 1, klev
     2457        prw(i) = prw(i) +
     2458     .           q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
     2459       ENDDO
     2460      ENDDO
     2461c
     2462cIM sorties bilans energie cinetique et potentielle MJO
    27192463      DO k = 1, klev
    2720        prw(i) = prw(i) +
    2721      .          q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
    2722       ENDDO
    2723 c      PRINT*,' i ',i,' prw',prw(i)
    2724       ENDDO
    2725 c
    2726 
     2464      DO i = 1, klon
     2465        d_u_oli(i,k) = d_u_oro(i,k) + d_u_lif(i,k)
     2466        d_v_oli(i,k) = d_v_oro(i,k) + d_v_lif(i,k)
     2467      ENDDO
     2468      ENDDO
    27272469c=============================================================
    27282470c   Ecriture des sorties
    27292471c=============================================================
     2472#ifdef histREGDYN
     2473#include "write_histREGDYN.h"
     2474#endif
    27302475
    27312476#ifdef histISCCP
    … …  
    27392484#include "write_histday.h"
    27402485#include "write_histmth.h"
     2486
     2487#ifdef histmthNMC
     2488#include "write_histmthNMC.h"
     2489#endif
     2490
    27412491#include "write_histins.h"
    27422492

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

    r463 r486  
    5454      CALL histwrite(nid_hf,"phi500",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
    5555
     56cIM cf FH
     57      CALL gr_fi_ecrit(1, klon,iim,jjmp1, u_seri(:,1),zx_tmp_2d)
     58      CALL histwrite(nid_hf,"u1",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     59c
     60      CALL gr_fi_ecrit(1, klon,iim,jjmp1, v_seri(:,1),zx_tmp_2d)
     61      CALL histwrite(nid_hf,"v1",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     62c
     63      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
     64      CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     65c
     66      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
     67      CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     68
    5669      if (ok_sync) then
    5770        call histsync(nid_hf)

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

    r471 r486  
    7676     .               ndex2d)
    7777c
    78       CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
     78cIM: 071003
     79      zx_tmp_fi2d(1:klon)=evap(1:klon)*86400.
     80      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
    7981      CALL histwrite(nid_mth,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
    8082c
    … …  
    9294c
    9395      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
    94       CALL histwrite(nid_mth,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
     96      CALL histwrite(nid_mth,"LWdnSFC",itau_w,zx_tmp_2d,iim*jjmp1,
    9597     .               ndex2d)
    96 c
     98cIM: 071003
     99      zx_tmp_fi2d(1:klon)=sollw(1:klon)+sollwdown(1:klon)
     100      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
     101      CALL histwrite(nid_mth,"LWupSFC",itau_w,zx_tmp_2d,iim*jjmp1,
     102     .               ndex2d)
     103cLWupSFC
    97104      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
    98105      CALL histwrite(nid_mth,"tops0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
    … …  
    234241      CALL histwrite(nid_mth,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
    235242c
     243      zx_tmp_fi2d(1:klon) = flwp(1:klon)
     244      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
     245      CALL histwrite(nid_mth,"lwp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     246c
     247      zx_tmp_fi2d(1:klon) = fiwp(1:klon)
     248      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
     249      CALL histwrite(nid_mth,"iwp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     250c
     251      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, flwc,zx_tmp_3d)
     252      CALL histwrite(nid_mth,"lwcon",itau_w,zx_tmp_3d,
     253     .               iim*jjmp1*klev,ndex3d)
     254c
     255      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, fiwc,zx_tmp_3d)
     256      CALL histwrite(nid_mth,"iwcon",itau_w,zx_tmp_3d,
     257     .               iim*jjmp1*klev,ndex3d)
     258c
    236259      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
    237260      CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
    … …  
    292315      CALL histwrite(nid_mth,"ovap",itau_w,zx_tmp_3d,
    293316     .                                   iim*jjmp1*klev,ndex3d)
     317cIM: 071003
     318      zx_tmp_fi3d(1:klon,1:klev)=qx(1:klon,1:klev,ivap)/
     319     .                         (1-qx(1:klon,1:klev,ivap))
     320      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_tmp_fi3d, zx_tmp_3d)
     321      CALL histwrite(nid_mth,"wvap",itau_w,zx_tmp_3d,
     322     .                                   iim*jjmp1*klev,ndex3d)
    294323c
    295324      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
    … …  
    333362     .                                   iim*jjmp1*klev,ndex3d)
    334363c
     364      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
     365      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
     366     .                                   iim*jjmp1*klev,ndex3d)
     367c
    335368      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
    336369      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
    … …  
    341374     .                                   iim*jjmp1*klev,ndex3d)
    342375c
    343       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
     376cIM: 101003 : K/30min ==> K/s
     377      zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys
     378      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    344379      CALL histwrite(nid_mth,"dtcon",itau_w,zx_tmp_3d,
    345380     .                                   iim*jjmp1*klev,ndex3d)
    … …  
    349384     .                                   iim*jjmp1*klev,ndex3d)
    350385c
    351       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
     386cIM: 101003 : K/30min ==> K/s
     387      zx_tmp_fi3d(1:klon,1:klev)=d_t_lsc(1:klon,1:klev)/pdtphys
     388      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    352389      CALL histwrite(nid_mth,"dtlsc",itau_w,zx_tmp_3d,
     390     .                                   iim*jjmp1*klev,ndex3d)
     391cIM: 071003
     392cIM: 101003 : K/30min ==> K/s
     393      zx_tmp_fi3d(1:klon, 1:klev)=(d_t_lsc(1:klon,1:klev)+
     394     .                             d_t_eva(1:klon,1:klev))/pdtphys
     395      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_tmp_fi3d, zx_tmp_3d)
     396      CALL histwrite(nid_mth,"dtlschr",itau_w,zx_tmp_3d,
    353397     .                                   iim*jjmp1*klev,ndex3d)
    354398c
    … …  
    357401     .                                   iim*jjmp1*klev,ndex3d)
    358402c
    359       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
     403cIM: 101003 : K/30min ==> K/s
     404      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)/pdtphys
     405      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    360406      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
    361407     .                                   iim*jjmp1*klev,ndex3d)
    … …  
    365411     .                                   iim*jjmp1*klev,ndex3d)
    366412c
    367       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
     413cIM: 101003 : K/30min ==> K/s
     414      zx_tmp_fi3d(1:klon,1:klev)=d_t_eva(1:klon,1:klev)/pdtphys
     415      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    368416      CALL histwrite(nid_mth,"dteva",itau_w,zx_tmp_3d,
    369417     .                                   iim*jjmp1*klev,ndex3d)
    … …  
    383431     .                                   iim*(jjmp1)*klev,ndex3d)
    384432c
    385       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
     433cIM: 101003 : K/30min ==> K/s
     434      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)/pdtphys
     435      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    386436      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
    387437     .                                   iim*jjmp1*klev,ndex3d)
    … …  
    391441     .                                   iim*jjmp1*klev,ndex3d)
    392442c
    393       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
     443cIM: 101003 : K/day ==> K/s
     444cIM: LMD_ARMIP3   zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)*pdtphys/RDAY
     445      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)/RDAY
     446      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    394447      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
    395448     .                                   iim*jjmp1*klev,ndex3d)
    396449c
    397       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
     450cIM: 101003 : K/day ==> K/s     
     451cIM: LMD_ARMIP3   zx_tmp_fi3d(1:klon,1:klev)=heat0(1:klon,1:klev)*pdtphys/RDAY
     452      zx_tmp_fi3d(1:klon,1:klev)=heat0(1:klon,1:klev)/RDAY
     453      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    398454      CALL histwrite(nid_mth,"dtsw0",itau_w,zx_tmp_3d,
    399455     .                                   iim*jjmp1*klev,ndex3d)
    400456c
    401       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
     457cIM: 101003 : K/day ==> K/s     
     458cIM: LMD_ARMIP3     zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)*pdtphys/RDAY
     459      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)/RDAY
     460      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    402461      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
    403462     .                                   iim*jjmp1*klev,ndex3d)
    404463c
    405       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
     464cIM: 101003 : K/day ==> K/s     
     465cIM: LMD_ARMIP3     zx_tmp_fi3d(1:klon,1:klev)=-1.*cool0(1:klon,1:klev)*pdtphys/RDAY
     466      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool0(1:klon,1:klev)/RDAY
     467      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    406468      CALL histwrite(nid_mth,"dtlw0",itau_w,zx_tmp_3d,
    407469     .                                   iim*jjmp1*klev,ndex3d)
    408470c
    409       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ec, zx_tmp_3d)
     471cIM: 101003 : deja en K/s     
     472      zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
     473      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
    410474      CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
    411475     .                                   iim*jjmp1*klev,ndex3d)
Note: See TracChangeset for help on using the changeset viewer.