! ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histday.h,v 1.2 2004/06/01 09:27:10 lmdzadmin Exp $ ! IF (ok_journe) THEN c ndex2d = 0 ndex3d = 0 zx_tmp_2d = 0. zx_tmp_3d = 0. zx_tmp_fi2d=0. zx_tmp_fi3d=0. c zsto = dtime zout = dtime * FLOAT(ecrit_day) itau_w = itau_phy + itap c c------------------------------------------------------- IF(lev_histday.GE.1) THEN c ccccccccccccc 2D fields, invariables c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) C CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d) CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c ccccccc axe Ls do j=1,jjmp1 do i=1,iim zx_tmp_2d(i,j)=zls*180./RPI ! zls est en radians !! enddo enddo CALL histwrite(nid_day,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c ccccccccccccc 2D fields, variables c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d) CALL histwrite(nid_day,"tsol",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_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d) c CALL histwrite(nid_day,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d) c CALL histwrite(nid_day,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c ENDIF !lev_histday.GE.1 c c------------------------------------------------------- IF(lev_histday.GE.2) THEN c ccccccccccccc 3D fields, basics c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d) CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d) CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d) CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d) CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d) CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d) CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d) CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d) CALL histwrite(nid_day,"dudyn",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d) CALL histwrite(nid_day,"duvdf",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c cccccccccccccccccc Tracers c if (iflag_trac.eq.1) THEN if (microfi.ge.1) then c DO iq=1,nmicro c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d) c CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d, c . iim*jjmp1*klev,ndex3d) c ENDDO c ------- NB AER TOT do i=1,klon do j=1,klev zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad)) enddo enddo CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"qaer",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c ------- NB NOY TOT do i=1,klon do j=1,klev zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad)) enddo enddo CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"qnoy",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c ------- V GLA1 TOT do i=1,klon do j=1,klev zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad)) enddo enddo CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"qgl1",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c ------- V GLA2 TOT do i=1,klon do j=1,klev zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad)) enddo enddo CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"qgl2",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c ------- V GLA3 TOT do i=1,klon do j=1,klev zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad)) enddo enddo CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"qgl3",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c -------------- c ----- SATURATION ESP NUAGES if (clouds.eq.1) then CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d) CALL histwrite(nid_day,"ch4sat", itau_w, zx_tmp_3d, . iim*jjmp1*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d) CALL histwrite(nid_day,"c2h6sat", itau_w, zx_tmp_3d, . iim*jjmp1*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d) CALL histwrite(nid_day,"c2h2sat", itau_w, zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c -------------- c ----- RESERVOIR DE SURFACE CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d) CALL histwrite(nid_day,"reserv",itau_w,zx_tmp_2d, . iim*jjmp1,ndex2d) c -------------- c ----- PRECIPITATIONS c ----- CH4 CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,1),zx_tmp_2d) CALL histwrite(nid_day,"prech4",itau_w,zx_tmp_2d, . iim*jjmp1,ndex2d) c ----- C2H6 CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,2),zx_tmp_2d) CALL histwrite(nid_day,"prec2h6",itau_w,zx_tmp_2d, . iim*jjmp1,ndex2d) c ----- C2H2 CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,3),zx_tmp_2d) CALL histwrite(nid_day,"prec2h2",itau_w,zx_tmp_2d, . iim*jjmp1,ndex2d) c c -------------- c ----- FLUX GLACE CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,1),zx_tmp_3d) CALL histwrite(nid_day,"flxgl1", itau_w, zx_tmp_3d, . iim*jjmp1*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,2),zx_tmp_3d) CALL histwrite(nid_day,"flxgl2", itau_w, zx_tmp_3d, . iim*jjmp1*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,3),zx_tmp_3d) CALL histwrite(nid_day,"flxgl3", itau_w, zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c c -------------- c ----- RAYON MOYEN GOUTTE CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d) CALL histwrite(nid_day,"rcldbar", itau_w, zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c endif endif c c -------------- c ----- TRACEURS CHIMIQUES if (nmicro.lt.nqmax) then DO iq=nmicro+1,nqmax CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d) CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) ENDDO endif endif c ENDIF !lev_histday.GE.2 c c------------------------------------------------------- IF(lev_histday.GE.3) THEN c cccccccccccccccccc Radiative transfer c c 2D c CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d) CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d) CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d) CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c c 3D c zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"SWnet",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"LWnet",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c c -------------- c ----- OPACITE BRUME do k=7,NSPECV,10 do i=1,klon do l=1,klev t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"thv"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECV do k=8,NSPECI,10 do i=1,klon do l=1,klev t_tauhvd(i,l)=TAUHID(i,klev-l+1,k) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"thi"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECI c c -------------- c ----- EXTINCTION BRUME do k=7,NSPECV,10 do i=1,klon do l=1,klev if(l.ne.klev) s t_khvd(i,l)=TAUHVD(i,klev-l+1,k) s -TAUHVD(i,klev-l+1-1,k) if(l.eq.klev) s t_khvd(i,l)=TAUHVD(i,klev-l+1,k) t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"khv"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECV do k=8,NSPECI,10 do i=1,klon do l=1,klev if(l.ne.klev) s t_khvd(i,l)=TAUHID(i,klev-l+1,k) s -TAUHID(i,klev-l+1-1,k) if(l.eq.klev) s t_khvd(i,l)=TAUHID(i,klev-l+1,k) t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"khi"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECI c c -------------- c ----- OPACITE GAZ do k=7,NSPECV,10 do i=1,klon do l=1,klev t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"tgv"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECV do k=8,NSPECI,10 do i=1,klon do l=1,klev t_tauhvd(i,l)=TAUGID(i,klev-l+1,k) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"tgi"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECI c c -------------- c ----- EXTINCTION GAZ do k=7,NSPECV,10 do i=1,klon do l=1,klev if(l.ne.klev) s t_khvd(i,l)=TAUGVD(i,klev-l+1,k) s -TAUGVD(i,klev-l+1-1,k) if(l.eq.klev) s t_khvd(i,l)=TAUGVD(i,klev-l+1,k) t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"kgv"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECV do k=8,NSPECI,10 do i=1,klon do l=1,klev if(l.ne.klev) s t_khvd(i,l)=TAUGID(i,klev-l+1,k) s -TAUGID(i,klev-l+1-1,k) if(l.eq.klev) s t_khvd(i,l)=TAUGID(i,klev-l+1,k) t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) enddo enddo write(str1,'(i2.2)') k zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"kgi"//str1,itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) enddo ! fin boucle NSPECI c -------------- c ----- OPACITE NUAGES (ATTENTION PROXY) if (clouds.eq.1) then zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"tcld",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c -------------- c ----- EXTINCTION NUAGES (ATTENTION PROXY) do i=1,klon t_kcld(i,klev)=occcld(i,klev) . /(zzlev(i,klev+1)-zzlev(i,klev)) do j=klev-1,1,-1 t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1)) . /(zzlev(i,j+1)-zzlev(i,j)) enddo enddo zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"kcld",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) endif c ENDIF !lev_histday.GE.3 c c------------------------------------------------------- IF(lev_histday.GE.4) THEN c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d) CALL histwrite(nid_day,"dtdyn",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d) CALL histwrite(nid_day,"dtphy",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c K/s zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"dtvdf",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c c K/s zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"dtajs",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c c K/s zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"dtswr",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c c K/s zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev) CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) CALL histwrite(nid_day,"dtlwr",itau_w,zx_tmp_3d, . iim*jjmp1*klev,ndex3d) c K/s c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev) c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) c CALL histwrite(nid_day,"dtec",itau_w,zx_tmp_3d, c . iim*jjmp1*klev,ndex3d) c ENDIF !lev_histday.GE.4 c c------------------------------------------------------- IF(lev_histday.GE.5) THEN c c c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d) c CALL histwrite(nid_day,"taux_",itau_w, c $ zx_tmp_2d,iim*jjmp1,ndex2d) c c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d) c CALL histwrite(nid_day,"tauy_",itau_w, c $ zx_tmp_2d,iim*jjmp1,ndex2d) c c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) c CALL histwrite(nid_day,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) c CALL histwrite(nid_day,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) c ENDIF !lev_histday.GE.5 c------------------------------------------------------- c if (ok_sync) then call histsync(nid_day) endif ENDIF