Layout of routine wr_diag

SUBROUTINE WR_DIAG(..) !**** *WR_DIAG* - writes diagnostics to NetCDF files ! Purpose. ! -------- ! writes out diagnostic variables !** Interface. ! ---------- ! *CALL* *WR_DIAG ! Explicit arguments : ! -------------------- ...... ! Implicit arguments : ! -------------------- ! Method. ! ------- ! See documentation ! Externals. ! ---------- ! None ! Reference. ! ---------- ! Author. ! ------- ! Bart vd Hurk (KNMI) ! Modifications. ! -------------- ! original: 14/7/2000 ........ PARAMETER (JPNCDF=6) REAL,ALLOCATABLE :: ZVALUE(:),ZOUTPUT(:),ZOUTPUT3(:,:) REAL,ALLOCATABLE :: ZSNOFR(:),ZICEFR(:) REAL*4,ALLOCATABLE :: ZOUTPUTS(:),ZOUTPUT3S(:,:) INTEGER ISTART1(1),ISTART3(3),ISTART4(4) INTEGER ICOUNT1(1),ICOUNT3(3),ICOUNT4(4) INTEGER IPOS(JPNCDF) REAL,ALLOCATABLE :: ZFSNNUA(:) ,ZQLINUA(:,:) ,ZLIQ(:,:) , & ZSWET(:) ,ZWRENUA(:) ,ZSROOT(:) , & ZFDEPT(:) ,ZFTHAW(:) ,ZSNDEP(:) #include "netcdf.inc" ! ZWA - FACTOR TO TRANSFORM W/M**2*S INTO W/M**2 ! ZMM - FACTOR TO TRANSFORM KG/M**2 INTO MM/S (AVERAGING) ! ZMM2 - FACTOR TO TRANSFORM KG/M**2 PER MODEL TIMESTEP INTO MM ! PER OUTPUT TIME STEP (ACCUMULATING) ZWA=1./(NFRPOS*TSTEP) ZMM=1./(NFRPOS*TSTEP) ZMM2=1./TSTEP IF(NSTEP.EQ.NSTART)THEN ZPA=1. ELSE ZPA=1./NFRPOS ENDIF !* UNIT CONVERSION OF PROGNOSTIC QUANTITIES ! ALLOCATE (ZFSNNUA(NPOI)) !RESCALED SNOW WATER MASS ALLOCATE (ZQLINUA(NPOI,NCSS)) !RESCALED SOIL WATER ALLOCATE (ZLIQ(NPOI,NCSS)) !LIQUID SOIL WATER ALLOCATE (ZSWET(NPOI)) !TOTAL SOIL WETNESS ALLOCATE (ZWRENUA(NPOI)) !RESCALED INTERCEPTION DEPTH ALLOCATE (ZSROOT(NPOI)) !ROOT AVAILABLE SOIL WATER ALLOCATE (ZFDEPT(NPOI)) !DEPTH OF FROZEN SOIL ALLOCATE (ZFTHAW(NPOI)) !DEPTH OF THAW LAYER ALLOCATE (ZSNDEP(NPOI)) !SNOW DEPTH ALLOCATE (ZSNOFR(NPOI)) !SNOW FRACTION ALLOCATE (ZICEFR(NPOI)) !ICE FRACTION ZFSNNUA(:)=.... ZWRENUA(:)=.... DO JK=1,NCSS ZQLINUA(1:NPOI,JK)=.... ZLIQ(1:NPOI,JK)=..... ENDDO !* calculation of total soil wetness plus root zone soil moisture content ! plus ... DO JL=1,NPOI ZSWET(JL)=.... ZSROOT(JL)=... ENDDO !* =============================================================== ! START OUTPUT !* =============================================================== IPOS(1)=NPOSEFL IPOS(2)=NPOSWAT IPOS(3)=NPOSSUS IPOS(4)=NPOSSUB IPOS(5)=NPOSEVA IPOS(6)=NPOSCLD ! time level CALL DATTIM(zjul,IYyMD,IHM) ! when accumulated or averaged output is required, output is backwar ! averaged, and output just before the first time step is skipped ISTART1(1)=(NSTEP-NSTART)/NFRPOS ISLOT=ISTART1(1) NSTPP=NSTEP ZTIME=RSTATI-0.5*TSTEP DO J=1,JPNCDF NPOS=IPOS(J) NVARID = NCVID(NPOS,'time',IERR) CALL NCVPT1 (NPOS,NVARID,ISTART1,ZTIME,IERR) NVARID = NCVID(NPOS,'timestp',IERR) CALL NCVPT1 (NPOS,NVARID,ISTART1,NSTPP,IERR) ENDDO !* -- The surface fluxes !****************************************************************** NPOS = NPOSEFL ISTART3(1)=1 ISTART3(2)=1 ISTART3(3)=ISLOT ICOUNT3(1)=NLON ICOUNT3(2)=NLAT ICOUNT3(3)=1 ISTART4(1)=1 ISTART4(2)=1 ISTART4(3)=1 ISTART4(4)=ISLOT ICOUNT4(1)=NLON ICOUNT4(2)=NLAT ICOUNT4(3)=NCSS ICOUNT4(4)=1 ALLOCATE (ZVALUE(NPOI)) ALLOCATE (ZOUTPUT(NLALO)) !INFLATED OUTPUT ARRAY ALLOCATE (ZOUTPUTS(NLALO)) !INFLATED OUTPUT ARRAY ALLOCATE (ZOUTPUT3(NLALO,NCSS)) !INFLATED OUTPUT ARRAY ALLOCATE (ZOUTPUT3S(NLALO,NCSS)) !INFLATED OUTPUT ARRAY ! net shortwave NVARID = NCVID(NPOS,'SWnet',IERR) ZVALUE(:)=(D1SRFLD2(:,IA)+D1SRFLU2(:,IA))*ZWA ZOUTPUT= UNPACK(ZVALUE,LMASK,RMISS) IF(NACCUR.EQ.1)THEN ZOUTPUTS(:)=ZOUTPUT(:) CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUTS,IERR) ELSE CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT,IERR) ENDIF ! net longwave NVARID = NCVID(NPOS,'LWnet',IERR) .....(etc) ! latent heat flux NVARID = NCVID(NPOS,'Qle',IERR) .....(etc) ! sensible heat flux NVARID = NCVID(NPOS,'Qh',IERR) .....(etc) ! soil heat flux NVARID = NCVID(NPOS,'Qg',IERR) .....(etc) ! soil freezing flux NVARID = NCVID(NPOS,'Qf',IERR) .....(etc) ! soil heat content change NVARID = NCVID(NPOS,'DelSoilHeat',IERR) .....(etc) ! snow heat content change NVARID = NCVID(NPOS,'DelColdCont',IERR) .....(etc) !* -- Water balance !****************************************************************** NPOS = NPOSWAT ! snowfall NVARID = NCVID(NPOS,'Snowf',IERR) .....(etc) ! rainfall NVARID = NCVID(NPOS,'Rainf',IERR) .....(etc) ! evapotranspiration NVARID = NCVID(NPOS,'Evap',IERR) .....(etc) ! surface runoff NVARID = NCVID(NPOS,'Qs',IERR) .....(etc) ! Subsurface runoff NVARID = NCVID(NPOS,'Qsb',IERR) .....(etc) ! snowmelt NVARID = NCVID(NPOS,'Qsm',IERR) .....(etc) ! soil water storage change NVARID = NCVID(NPOS,'DelSoilMoist',IERR) .....(etc) ! snow water storage change NVARID = NCVID(NPOS,'DelSWE',IERR) .....(etc) ! interception water storage change NVARID = NCVID(NPOS,'DelIntercept',IERR) .....(etc) !* -- Surface state variables !****************************************************************** NPOS = NPOSSUS ! snow temperature NVARID = NCVID(NPOS,'SnowT',IERR) ! set to 0 when cover is zero WHERE(ZSNOFR(1:NPOI) == 0.) ZVALUE(1:NPOI)=RMISS ELSEWHERE ZVALUE(1:NPOI)=D1SNTFR2(1:NPOI,IA)*ZWA/ZSNOFR(1:NPOI) END WHERE ZOUTPUT= UNPACK(ZVALUE,LMASK,RMISS) IF(NACCUR.EQ.1)THEN ZOUTPUTS(:)=ZOUTPUT(:) CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUTS,IERR) ELSE CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT,IERR) ENDIF ! vegetation temperature NVARID = NCVID(NPOS,'VegT',IERR) .....(etc) ! bare soil temperature NVARID = NCVID(NPOS,'BaresoilT',IERR) .....(etc) ! average surface temperature NVARID = NCVID(NPOS,'AvgSurfT',IERR) .....(etc) ! surface radiative temperature NVARID = NCVID(NPOS,'RadT',IERR) .....(etc) ! surface albedo NVARID = NCVID(NPOS,'Albedo',IERR) .....(etc) ! snow water equivalent NVARID = NCVID(NPOS,'SWE',IERR) .....(etc) !* -- Sub-surface state variables !****************************************************************** NPOS = NPOSSUB ! soil temperature NVARID = NCVID(NPOS,'SoilTemp',IERR) DO JK=1,NCSS ZVALUE(:)=TSLNUA(:,JK)*ZPA ZOUTPUT3(:,JK)=UNPACK(ZVALUE,LMASK,RMISS) ENDDO IF(NACCUR.EQ.1)THEN ZOUTPUT3S(:,:)=ZOUTPUT3(:,:) CALL NCVPT (NPOS,NVARID,ISTART4,ICOUNT4,ZOUTPUT3S,IERR) ELSE CALL NCVPT (NPOS,NVARID,ISTART4,ICOUNT4,ZOUTPUT3,IERR) ENDIF ! soil moisture NVARID = NCVID(NPOS,'SoilMoist',IERR) .....(etc) ! liquid soil moisture NVARID = NCVID(NPOS,'LSoilMoist',IERR) .....(etc) ! total soil wetness NVARID = NCVID(NPOS,'SoilWet',IERR) .....(etc) !* -- Evaporation components !****************************************************************** NPOS = NPOSEVA ! interception evaporation NVARID = NCVID(NPOS,'ECanop',IERR) .....(etc) ! vegetation transpiration NVARID = NCVID(NPOS,'TVeg',IERR) .....(etc) ! bare soil evaporation NVARID = NCVID(NPOS,'ESoil',IERR) .....(etc) ! rootzone soil moisture NVARID = NCVID(NPOS,'RootMoist',IERR) .....(etc) ! Canopy interception NVARID = NCVID(NPOS,'CanopInt',IERR) .....(etc) ! Snow sublimation NVARID = NCVID(NPOS,'SubSnow',IERR) .....(etc) !* -- Cold-season processes !****************************************************************** NPOS = NPOSCLD ! Snow fraction NVARID = NCVID(NPOS,'SnowFrac',IERR) .....(etc) ! Ice fraction NVARID = NCVID(NPOS,'IceFrac',IERR) .....(etc) !* -- Frozen soil depth NVARID = NCVID(NPOS,'Fdepth',IERR) .....(etc) !* -- Depth to soil thaw NVARID = NCVID(NPOS,'Tdepth',IERR) .....(etc) !* -- Snow albedo NVARID = NCVID(NPOS,'SAlbedo',IERR) WHERE(ZSNOFR(1:NPOI) == 0.) ZVALUE(1:NPOI)=RMISS ELSEWHERE ZVALUE(1:NPOI)=D1SNAFR2(1:NPOI,IA)*ZWA/ZSNOFR(1:NPOI) END WHERE .....(etc) !* -- Snow depth NVARID = NCVID(NPOS,'SnowDepth',IERR) .....(etc) RETURN END SUBROUTINE WRTDCDF