!------------------------------------------------------------------------- ! NASA GSFC Land Information Systems LIS 2.3 ! !------------------------------------------------------------------------- !BOP ! ! !ROUTINE: noah_writerst.F90 ! ! !DESCRIPTION: ! This program writes restart files for NOAH. This ! includes all relevant water/energy storages, tile information, ! and time information. It also rectifies changes in the tile space. ! ! ! !REVISION HISTORY: ! 1 Oct 1999: Jared Entin; Initial code ! 15 Oct 1999: Paul Houser; Significant F90 Revision ! 05 Sep 2001: Brian Cosgrove; Modified code to use Dag Lohmann's NOAA ! initial conditions if necessary. This is controlled with ! local variable NOAAIC. Normally set to 0 in this subroutine ! but set to 1 if want to use Dag's NOAA IC's. Changed output ! directory structure, and commented out if-then check so that ! directory is always made. ! 28 Apr 2002: Kristi Arsenault; Added NOAH LSM into LDAS ! 28 May 2002: Kristi Arsenault; For STARTCODE=4, corrected SNEQV values ! and put SMC, SH2O, STC limit for GDAS and GEOS forcing. ! 14 Jun 2003: Sujay Kumar , Separated the write restart from the original ! code ! RESTART FILE FORMAT(fortran sequential binary): ! YR,MO,DA,HR,MN,SS,VCLASS,NCH !Restart time,Veg class,no.tiles, no.soil lay ! TILE(NCH)%COL !Grid Col of Tile ! TILE(NCH)%ROW !Grid Row of Tile ! TILE(NCH)%FGRD !Fraction of Grid covered by tile ! TILE(NCH)%VEGT !Vegetation Type of Tile ! NOAH(NCH)%STATES !Model States in Tile Space ! ! !INTERFACE: subroutine noah_writerst() ! !uses: use lisdrv_module, only : lis,tile use lis_module !3.1 use time_module USE noah_varder ! NOAH tile variables use time_manager use tile_spmdMod !EOP IMPLICIT NONE !=== Local Variables ===================================================== integer :: c,r,t,i,j,l,n,f ! loop counters character*80 filen,mkfyrmo character*1 fname(80),fbase(80),fsubs(80),fmkdir(80) character*1 ftime(10),fyrmodir(80) !=== Temporary tile space transfer files (different than in lis_module) real, allocatable :: tmptilen(:) CHARACTER (LEN=100) :: temp !=== Variables for noah_binout integer ftn character*80 fileb !=== End Variable Definition ============================================= !BOC if(masterproc) then !------------------------------------------------------------------------- ! Restart Writing (2 files are written = active and archive) !------------------------------------------------------------------------- PRINT*,"J---noah_writerst" PRINT*,"lis%t%gmt = ", lis%t%gmt PRINT*,"noahdrv%writeintn = ", noahdrv%writeintn !JESSE 20071219 WRITERST AT 00Z ONLY ! if((lis%t%gmt.eq.(24-noahdrv%writeintn)) & if((lis%t%gmt.eq.0.) & .or.lis%t%endtime.eq.1)then allocate(tmptilen(lis%d%nch)) ! open(40,file=noahdrv%noah_rfile,form='unformatted') !Active archive restart ! call timemgr_write_restart(40) ! ! write(40) lis%p%vclass,lis%d%lnc,lis%d%lnr,lis%d%nch !Veg class, no tiles ! write(40) noah%t1 !NOAH Skin Temperature (K) ! write(40) noah%cmc !NOAH Canopy Water Content ! write(40) noah%snowh !NOAH Actual Snow Depth ! write(40) noah%sneqv !NOAH Water Equivalent Snow Depth ! do l=1,4 ! do t=1,lis%d%nch ! tmptilen(t)=noah(t)%stc(l) ! enddo ! write(40) tmptilen !NOAH Soil Temperature (4 layers) ! enddo ! do l=1,4 ! do t=1,lis%d%nch ! tmptilen(t)=noah(t)%smc(l) ! enddo ! write(40) tmptilen !NOAH Total Soil Moist. (4 layers) ! enddo ! do l=1,4 ! do t=1,lis%d%nch ! tmptilen(t)=noah(t)%sh2o(l) ! enddo ! write(40) tmptilen !NOAH Liquid Soil Moist. (4 layers) ! enddo ! write(40) noah%ch !NOAH Heat/Moisture Sfc Exchange Coef. ! write(40) noah%cm !NOAH Momentum Sfc Exchange Coef. ! close(40) ! write(*,*)'Noah Active restart written: ',noahdrv%noah_rfile write(unit=temp,fmt='(i4,i2,i2,i2)') lis%t%yr,lis%t%mo, & lis%t%da,lis%t%hr read(unit=temp,fmt='(10a1)')ftime do i=1,10 if(ftime(i).eq.(' '))ftime(i)='0' enddo write(unit=temp,fmt='(a4,i3,a6,i4,a1,i4,i2,i2,a6,i3,a1)') & '/EXP',lis%o%expcode,'/NOAH/',lis%t%yr, & '/',lis%t%yr,lis%t%mo, & lis%t%da,'/LIS.E',lis%o%expcode,'.' read(unit=temp,fmt='(80a1)') (fname(i),i=1,37) do i=1,37 if(fname(i).eq.(' '))fname(i)='0' enddo write(unit=temp,fmt='(a9)')'mkdir -p ' read(unit=temp,fmt='(80a1)')(fmkdir(i),i=1,9) write(unit=temp,fmt='(a4,i3,a6,i4,a1,i4,i2,i2)') & '/EXP',lis%o%expcode,'/NOAH/', & lis%t%yr,'/',lis%t%yr,lis%t%mo,lis%t%da read(unit=temp,fmt='(80a1)') (fyrmodir(i),i=1,26) do i=1,26 if(fyrmodir(i).eq.(' '))fyrmodir(i)='0' enddo write(unit=temp,fmt='(a8)')'.Noahrst' read(unit=temp,fmt='(80a1)') (fsubs(i),i=1,8) write(unit=temp,fmt='(a40)') lis%o%odir read(unit=temp,fmt='(80a1)') (fbase(i),i=1,80) c=0 do i=1,80 if(fbase(i).eq.(' ').and.c.eq.0)c=i-1 enddo write(unit=temp,fmt='(80a1)')(fbase(i),i=1,c),(fname(i),i=1,36), & (ftime(i),i=1,10),(fsubs(i),i=1,8) read(unit=temp,fmt='(a80)')filen write(unit=temp,fmt='(80a1)')(fmkdir(i),i=1,9),(fbase(i),i=1,c), & (fyrmodir(i),i=1,26) read(unit=temp,fmt='(a80)')mkfyrmo !------------------------------------------------------------------------- ! Archive File Name Generation Complete ! Make the directories for the NOAH restart file !------------------------------------------------------------------------- CALL SYSTEM(MKFYRMO) !------------------------------------------------------------------------- ! Archive File Name Generation Complete !------------------------------------------------------------------------- open(40,file=filen,status='unknown',form='unformatted') write(*,*) 'restart file=', filen call timemgr_write_restart(40) write(40) lis%p%vclass,lis%d%lnc,lis%d%lnr,lis%d%nch !veg class, no tiles write(40) noah%tskin !noah skin temperature (k) write(40) noah%canopy !noah canopy water content write(40) noah%snwdph !noah actual snow depth write(40) noah%weasd !noah water equivalent snow depth do l=1,4 do t=1,lis%d%nch tmptilen(t)=noah(t)%stc(l) enddo write(40) tmptilen !noah soil temperature (4 layers) enddo do l=1,4 do t=1,lis%d%nch tmptilen(t)=noah(t)%smc(l) enddo write(40) tmptilen !noah total soil moist. (4 layers) enddo do l=1,4 do t=1,lis%d%nch tmptilen(t)=noah(t)%slc(l) enddo write(40) tmptilen !noah liquid soil moist. (4 layers) enddo write(40) noah%chxy !noah heat/moisture sfc exchange coef. write(40) noah%cmxy !noah momentum sfc exchange coef. write(40) noah%zorl ! roughness length write(40) noah%tsurf write(40) noah%trans ! NOAHMP intials write(40) noah%tprcp write(40) noah%srflag write(40) noah%alboldxy write(40) noah%sneqvoxy write(40) noah%tahxy write(40) noah%eahxy write(40) noah%fwetxy write(40) noah%canliqxy write(40) noah%canicexy write(40) noah%tvxy write(40) noah%tgxy write(40) noah%qsnowxy write(40) noah%snowxy write(40) noah%zwtxy write(40) noah%waxy write(40) noah%wtxy write(40) noah%wslakexy write(40) noah%lfmassxy write(40) noah%rtmassxy write(40) noah%stmassxy write(40) noah%woodxy write(40) noah%stblcpxy write(40) noah%fastcpxy write(40) noah%xlaixy write(40) noah%xsaixy write(40) noah%taussxy write(40) noah%smcwtdxy write(40) noah%deeprechxy write(40) noah%rechxy ! ----------- snow temperature [k] ----------------------------- do l=1,3 do t=1,lis%d%nch tmptilen(t)=noah(t)%tsnoxy(l) enddo write(40) tmptilen enddo ! ------------layer-bottom depth from snow surf to 2m soil [m] --------- do l=1,7 do t=1,lis%d%nch tmptilen(t)=noah(t)%zsnsoxy(l) enddo write(40) tmptilen enddo ! ---------------snow layer ice [mm] ----------------------------------- do l=1,3 do t=1,lis%d%nch tmptilen(t)=noah(t)%snicexy(l) enddo write(40) tmptilen enddo ! --------------snow layer liquid water [mm] ---------------------------- do l=1,3 do t=1,lis%d%nch tmptilen(t)=noah(t)%snliqxy(l) enddo write(40) tmptilen enddo ! --------------equilibrium soil water  content [m3/m3]------------------ do l=1,4 do t=1,lis%d%nch tmptilen(t)=noah(t)%smoiseq(l) enddo write(40) tmptilen enddo close(40) write(*,*)'noah archive restart written: ',filen deallocate(tmptilen) !------------------------------------------------------------------------- ! WRITE RESTART FILE IN 2D BINARY !------------------------------------------------------------------------- ftn = 58 write(fileb,'(a5,i3,a6,i4,a1,i4,i2.2,i2.2,a6,i3,a1,i4,3i2.2,a9)') & './EXP',lis%o%expcode,'/NOAH/', & lis%t%yr,'/',lis%t%yr,lis%t%mo,lis%t%da, & '/LIS.E',lis%o%expcode,'.', & lis%t%yr,lis%t%mo,lis%t%da,lis%t%hr,'.NOAHgbin' open(ftn,file=fileb,form='unformatted') write(*,*) 'fileb=', fileb call noah_binout(lis,ftn) close(ftn) endif endif return !EOC end subroutine noah_writerst