source: LMDZ4/branches/LMDZ4_V3_patches/libf/phylmd/write_histhf.h @ 4227

!
! $Header$
!
      if (ok_hf) then

c
      ndex2d = 0
      ndex3d = 0
c
      itau_w = itau_phy + itap
c
      IF(type_run.EQ."CLIM".OR.type_run.EQ."ENSP") THEN
c
      IF(lev_histhf.GE.1) THEN
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"aireTER",itau_w,paire_ter)
c
      DO i=1, klon
       zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
      ENDDO
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"contfracATM",itau_w,zx_tmp_fi2d)
c
cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"contfracOR",itau_w,
     .                   pctsrf_new(:,is_ter))
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"t2m",itau_w,zt2m)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"q2m",itau_w,zq2m)
c
      DO i = 1, klon
         zx_tmp_fi2d(i) = paprs(i,1)
      ENDDO
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"psol",itau_w,zx_tmp_fi2d)
c
      DO i = 1, klon
         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
      ENDDO
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"precip",itau_w,zx_tmp_fi2d)
c
c ENSEMBLES BEG
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"tsol",itau_w,zxtsol)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"slp",itau_w,slp)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"u10m",itau_w,zu10m)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"v10m",itau_w,zv10m)
c
      DO i=1, klon
       zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
      ENDDO
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"wind10m",itau_w,zx_tmp_fi2d)
c
      DO k=1, nlevSTD
c
      bb2=clevSTD(k)
      IF(bb2.EQ."500") THEN
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, philevSTD(:,k),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"phi"//bb2,itau_w, philevSTD(:,k))
      ENDIF !bb2.EQ."500"
      ENDDO
c
      ENDIF !lev_histhf.GE.1
c
      IF(lev_histhf.GE.2) THEN
c
cIM 140904 BEG
      DO i = 1, klon
         zx_tmp_fi2d(i) = cldt(i)*100.
      ENDDO
cIM 140904 END
cIM 140904   CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"cldt",itau_w,zx_tmp_fi2d)
c
      zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"SWnetOR",itau_w, zx_tmp_fi2d)
c
      zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"SWdownOR",itau_w, zx_tmp_fi2d)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"LWdownOR",itau_w,sollwdown) 
c
c
      ENDIF !lev_histhf.GE.2
c
      IF(lev_histhf.GE.3) THEN
c
      DO k=1, nlevSTD
c
      bb2=clevSTD(k)
      IF(bb2.EQ."1000".OR.bb2.EQ."925".OR.
     $      bb2.EQ."850".OR.bb2.EQ."700".OR.
     $      bb2.EQ."500".OR.bb2.EQ."300".OR.
     $      bb2.EQ."250".OR.bb2.EQ."200".OR.
     $      bb2.EQ."150".OR.bb2.EQ."100".OR.
     $      bb2.EQ."50".OR.bb2.EQ."30".OR.
     $      bb2.EQ."10")THEN
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"t"//bb2,itau_w, tlevSTD(:,k))
c
      IF(bb2.NE."500") THEN !bb2.NE."500"
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1,philevSTD(:,k),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"phi"//bb2,itau_w,philevSTD(:,k))
      ENDIF !bb2.NE."500"
c
      IF(bb2.GE."200") THEN
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlevSTD(:,k),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"q"//bb2,itau_w, qlevSTD(:,k))
      ENDIF
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"u"//bb2,itau_w,ulevSTD(:,k))
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"v"//bb2,itau_w, vlevSTD(:,k))
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, wlevSTD(:,k),zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"w"//bb2,itau_w, wlevSTD(:,k))
c
      ENDIF
      ENDDO !nlevENS
c
      IF(1.EQ.0) THEN
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"cdrm",itau_w,cdragm)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"cdrh",itau_w,cdragh)
      ENDIF !(1.EQ.0) THEN
c
      ENDIF !lev_histhf.GE.3
c
      IF(lev_histhf.GE.4) THEN 
c
#undef histhf3d
#define histhf3d
#ifdef histhf3d
#include "write_histhf3d.h"
#endif
c
      ENDIF !lev_histhf.GE.4
c
      ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
c
      IF(lev_histhf.GE.1) THEN
c
      DO k=1, nlevSTD
c        bb=clevSTD(k)
c
c        IF(k.GE.2) THEN
         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
c         aa=clevSTD(k)
c         bb=aa(1:lnblnk1(aa))
c        ENDIF
c
        IF(bb2.EQ."850".or.bb2.EQ."200") THEN
c
cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
        CALL histwrite_phy(nid_hf,"u"//bb2,itau_w,ulevSTD(:,k))
c
cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
        CALL histwrite_phy(nid_hf,"v"//bb2,itau_w,vlevSTD(:,k))
c
        ENDIF !bb2.EQ."850".or.bb2.EQ."200"
c
      ENDDO !nlevSTD
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"topl",itau_w,toplw)
c
      DO i = 1, klon
         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
      ENDDO
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"precip",itau_w,zx_tmp_fi2d)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"slp",itau_w,slp)
c
cIM 280504 BEG
      ENDIF !(lev_histhf.GE.1) THEN
c
      IF(lev_histhf.GE.2) THEN
c
       DO k=1, nlevSTD
c
c        bb=clevSTD(k)
c
c        IF(k.GE.2) THEN
         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
c         aa=clevSTD(k)
c         bb=aa(1:lnblnk1(aa))
c        ENDIF
c
        IF(bb2.EQ."850".or.bb2.EQ."500") THEN
c
cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
         CALL histwrite_phy(nid_hf,"t"//bb2,itau_w,tlevSTD(:,k))
c
cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlevSTD(:,k),zx_tmp_2d)
         CALL histwrite_phy(nid_hf,"q"//bb2,itau_w, qlevSTD(:,k))
c
        ENDIF !bb2.EQ."850".or.bb2.EQ."500"
c
        IF(bb2.EQ."500") THEN
c
cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, philevSTD(:,k),zx_tmp_2d)
         CALL histwrite_phy(nid_hf,"phi"//bb2,itau_w, philevSTD(:,k))
c
cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, wlevSTD(:,k),zx_tmp_2d)
        CALL histwrite_phy(nid_hf,"w"//bb2,itau_w, wlevSTD(:,k))
c
        ENDIF !bb2.EQ."500"
c
        IF(bb3.EQ."50") THEN
c
cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
         CALL histwrite_phy(nid_hf,"t"//bb3,itau_w, tlevSTD(:,k))
c
cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
        CALL histwrite_phy(nid_hf,"u"//bb3,itau_w, ulevSTD(:,k))
c
cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
        CALL histwrite_phy(nid_hf,"v"//bb3,itau_w, vlevSTD(:,k))
c
        ENDIF !bb3.EQ."50"
c
       ENDDO !k=1, nlevSTD
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"u10m",itau_w,zu10m)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"v10m",itau_w,zv10m)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"t2m",itau_w, zt2m)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"q2m",itau_w,zq2m)
c
      DO i = 1, klon
         zx_tmp_fi2d(i) = paprs(i,1)
      ENDDO
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"psol",itau_w,zx_tmp_fi2d)
c
cIM 140904 BEG
      DO i = 1, klon
         zx_tmp_fi2d(i) = cldt(i)*100.
      ENDDO
cIM 140904 END
cIM 140904   CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"cldt",itau_w,zx_tmp_fi2d)
c
      zx_tmp_fi2d(1 : klon) = zxfluxu(1 : klon, 1)
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"taux",itau_w,zx_tmp_fi2d)
C
      zx_tmp_fi2d(1 : klon) = zxfluxv(1 : klon, 1)
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"tauy",itau_w,zx_tmp_fi2d)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, prw,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"prw",itau_w,prw)
c
      zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"sens",itau_w,zx_tmp_fi2d)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxfluxlat,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"flat",itau_w,zxfluxlat)
c
c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, zsnow_mass,zx_tmp_2d)
c     CALL histwrite_phy(nid_hf,"snow_mass",itau_w,zsnow_mass)
c
      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 1 )
cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf, "SWdnSFC",itau_w,zx_tmp_fi2d)
c
      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 1 )
cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf, "SWupSFC",itau_w,zx_tmp_fi2d)
c
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"LWdnSFC",itau_w,sollwdown)
c
cIM 090904   zx_tmp_fi2d(1:klon)=sollw(1:klon)+sollwdown(1:klon)
cIM 130904   zx_tmp_fi2d(1:klon)=sollw(1:klon)-sollwdown(1:klon)
      zx_tmp_fi2d(1:klon)=sollwdown(1:klon)-sollw(1:klon)
cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
      CALL histwrite_phy(nid_hf,"LWupSFC",itau_w,zx_tmp_fi2d)                    
c
      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, klevp1 )
cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf, "SWdnTOA",itau_w,zx_tmp_fi2d)
c
      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, klevp1 )
cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
      CALL histwrite_phy(nid_hf, "SWupTOA",itau_w,zx_tmp_fi2d)
c
      IF (is_sequential) THEN
cym      CALL gr_fi_ecrit(nbteta,klon,iim,jjmp1,PVteta,zx_tmp_3dte)
      DO k=1, nbteta
       zx_tmp_fi2d(1:klon) = PVteta(1:klon,k)
       CALL histwrite_phy(nid_hf,"PV"//ctetaSTD(k),
     .      itau_w,zx_tmp_fi2d)
      ENDDO !k=1, nbteta
      ENDIF
c
c
c planetary boundary layer height
c
c     ENDIF !1.EQ.0
c
      ENDIF !(lev_histhf.GE.2) THEN
cIM 280504 END
c
      ENDIF !type_run
c
      IF (ok_sync) THEN
c$OMP MASTER
        call histsync(nid_hf)
c$OMP END MASTER
      ENDIF

      ENDIF