Layout of routine wr_prog

SUBROUTINE WR_PROG !**** *WR_PROG* - Writing prognostic variables of the one-column surface model ! Purpose. ! -------- ! Write out prognostic variables in NetCDF format !** Interface. ! ---------- ! *CALL* *WR_PROG ! Explicit arguments : ! -------------------- ! Implicit arguments : ! -------------------- ! Method. ! ------- ! See documentation ! Externals. ! ---------- ! None ! Reference. ! ---------- ! ECMWF Research Department documentation ! of the one-column surface model ! Author. ! ------- ! Bart vd Hurk *KNMI* ! Modifications. ! -------------- ! Original : 2000-07-24 ! ------------------------------------------------------------------ ...... IMPLICIT LOGICAL (L) PARAMETER (JPNCDF=1) INTEGER ISTART1(1),ISTART3(3),ISTART4(4) INTEGER ICOUNT1(1),ICOUNT3(3),ICOUNT4(4) INTEGER IPOS(JPNCDF) REAL,ALLOCATABLE :: ZFSNNU0(:) ,ZWRENU0(:) ,ZQLINU0(:,:), & ZOUTPUT(:) ,ZOUTPUT3(:,:) REAL*4,ALLOCATABLE :: ZOUTPUTS(:), ZOUTPUT3S(:,:) #include "netcdf.inc" ...... ! ------------------------------------------------------------------ !* 1. SCALING SOME VARIABLES. ! ----------------------- ..... ZFSNNU0(:)=FSNNU0(:)*RHOH2O ZWRENU0(:)=WRENU0(:)*RHOH2O DO JK=1,NCSS ZQLINU0(1:NPOI,JK)=QLINU0(1:NPOI,JK)*RDAW(JK)*RHOH2O ENDDO ! 6. WRITE TO NETCDF FILES ! IPOS(1)=NPOSGG ! time level CALL DATTIM(zjul,IYyMD,IHM) NSTPP=NSTEP ZTIME=RSTATI-0.5*TSTEP ISTART1(1)=(NSTEP-NSTART)/NFRPOS+1 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 PROGNOSTIC OUTPUT FILE NPOS=NPOSGG ISTART3(1)=1 ISTART3(2)=1 ISTART3(3)=(NSTEP-NSTART)/NFRPOS+1 ICOUNT3(1)=NLON ICOUNT3(2)=NLAT ICOUNT3(3)=1 ! skin temperature NVARID = NCVID(NPOS,'AvgSurfT',IERR) ZOUTPUT= UNPACK(TRENU0,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 ! skin layer content NVARID = NCVID(NPOS,'CanopInt',IERR) .....(etc) ! snow mass NVARID = NCVID(NPOS,'SWE',IERR) .....(etc) ! snow temp NVARID = NCVID(NPOS,'SnowT',IERR) .....(etc) ! snow density NVARID = NCVID(NPOS,'snowdens',IERR) .....(etc) ! snow albedo NVARID = NCVID(NPOS,'SAlbedo',IERR) .....(etc) ISTART4(1)=1 ISTART4(2)=1 ISTART4(3)=1 ISTART4(4)=(NSTEP-NSTART)/NFRPOS+1 ICOUNT4(1)=NLON ICOUNT4(2)=NLAT ICOUNT4(3)=NCSS ICOUNT4(4)=1 ! soil temperature NVARID = NCVID(NPOS,'SoilTemp',IERR) DO JK=1,NCSS ZOUTPUT3(:,JK)=UNPACK(TSLNU0(:,JK),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) ! sea ice temperature NVARID = NCVID(NPOS,'icetemp',IERR) .....(etc) ! -------------------------------------------------------- RETURN END SUBROUTINE WR_PROG