! ! $Header$ ! if (ok_hf) then c Comprendre comment marche el i=nint(zout/zsto) c c print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! ' ndex2d = 0 ndex3d = 0 c zsto = dtime zout = dtime * ecrit_hf itau_w = itau_phy + itap c IF(lev_histhf.GE.1) THEN c c i = NINT(zout/zsto) c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) c CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d) c c i = NINT(zout/zsto) c CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d) c CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d) C CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d) CALL histwrite(nid_hf,"aireTER",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c DO i=1, klon zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic) ENDDO c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d) CALL histwrite(nid_hf,"contfracATM",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d) CALL histwrite(nid_hf,"contfracOR",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d) CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1, . ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d) CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1, . ndex2d) c DO i = 1, klon zx_tmp_fi2d(i) = paprs(i,1) ENDDO CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1, . ndex2d) c DO i = 1, klon zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i) ENDDO CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c c ENSEMBLES BEG CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d) CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d) CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d) CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c DO i=1, klon zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) ENDDO CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c DO k=1, nlevENS IF(clev(k).EQ."500") THEN CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) ENDIF !clev(k).EQ."500" ENDDO c ENDIF !lev_histhf.GE.1 c IF(lev_histhf.GE.2) THEN c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d) CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter) CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) CALL histwrite(nid_hf,"SWnetOR",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon)) CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d) CALL histwrite(nid_hf,"SWdownOR",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d) CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1, $ ndex2d) c c ENDIF !lev_histhf.GE.2 c IF(lev_histhf.GE.3) THEN c DO k=1, nlevENS c CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c IF(clev(k).NE."500") THEN !clev(k).NE."500" CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) ENDIF !clev(k).NE."500" c CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c IF(1.EQ.0) THEN CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) ENDIF !1.EQ.0 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c ENDDO !nlevENS c IF(1.EQ.0) THEN CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) ENDIF !(1.EQ.0) THEN c ENDIF !lev_histhf.GE.3 c IF(lev_histhf.GE.4) THEN c #define histhf3d #ifdef histhf3d #include "write_histhf3d.h" #endif c ENDIF !lev_histhf.GE.4 c if (ok_sync) then call histsync(nid_hf) endif endif if (ok_hf) then c Comprendre comment marche el i=nint(zout/zsto) c c print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! ' ndex2d = 0 ndex3d = 0 c zsto = dtime zout = dtime * ecrit_hf itau_w = itau_phy + itap c IF(lev_histhf.GE.1) THEN c c i = NINT(zout/zsto) c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) c CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d) c c i = NINT(zout/zsto) c CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d) c CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d) C CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d) CALL histwrite(nid_hf,"aireTER",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c DO i=1, klon zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic) ENDDO c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d) CALL histwrite(nid_hf,"contfracATM",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d) CALL histwrite(nid_hf,"contfracOR",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d) CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1, . ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d) CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1, . ndex2d) c DO i = 1, klon zx_tmp_fi2d(i) = paprs(i,1) ENDDO CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1, . ndex2d) c DO i = 1, klon zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i) ENDDO CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c c ENSEMBLES BEG CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d) CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d) CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d) CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c DO i=1, klon zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) ENDDO CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c DO k=1, nlevENS IF(clev(k).EQ."500") THEN CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) ENDIF !clev(k).EQ."500" ENDDO c ENDIF !lev_histhf.GE.1 c IF(lev_histhf.GE.2) THEN c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d) CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c c -- LOOP zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter) CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) CALL histwrite(nid_hf,"SWnetOR",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, swdownor , zx_tmp_2d) CALL histwrite(nid_hf,"SWdownOR",itau_w, $ zx_tmp_2d,iim*jjmp1,ndex2d) c -- LOOP c CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d) CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1, $ ndex2d) c c ENDIF !lev_histhf.GE.2 c IF(lev_histhf.GE.3) THEN c DO k=1, nlevENS c CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c IF(clev(k).NE."500") THEN !clev(k).NE."500" CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) ENDIF !clev(k).NE."500" c CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c IF(1.EQ.0) THEN CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) ENDIF !1.EQ.0 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d) CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d, $ iim*jjmp1,ndex2d) c ENDDO !nlevENS c IF(1.EQ.0) THEN CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) ENDIF !(1.EQ.0) THEN c ENDIF !lev_histhf.GE.3 c IF(lev_histhf.GE.4) THEN c #define histhf3d #ifdef histhf3d #include "write_histhf3d.h" #endif c ENDIF !lev_histhf.GE.4 c if (ok_sync) then call histsync(nid_hf) endif endif