SUBROUTINE drv_postproc(ip, sibio, rfrio) !====================================================================== ! Description: Prepare for post-processing ! ! $Log: drv_postproc.f90,v $ ! Revision 1.1 2002/08/19 18:47:27 guo ! Initial revision ! !====================================================================== USE drv_dat_mod USE sib_io_mod USE rfr_io_mod IMPLICIT NONE TYPE (sibiodec) :: sibio TYPE (rfriodec) :: rfrio REAL :: wws(idp) INTEGER :: j INTEGER :: l INTEGER :: ip, i !nf if (ip == 1000) write(6,*) sibio%www !** Running sums for the decad averages do i=1,idp wws(i)= sibio%www(i)*sibio%porosd(i)*sibio%zdepth(i) enddo !gswp1 Dw1(ip) = Dw1(ip) + wws(1)*1000.0 !gswp1 Dw2(ip) = Dw2(ip) + (wws(1)+wws(2))*1000.0 !gswp1 Dw3(ip) = Dw3(ip) + (wws(1)+wws(2)+wws(3))*1000.0 !gswp1 Dwi1(ip) = Dwi1(ip) + (wws(1)*1000.0-wilpo1(ip))/ & !gswp1 (ficap1(ip)-wilpo1(ip)) !gswp1 Dwi2(ip) = Dwi2(ip) + ((wws(1)+wws(2))*1000.0-wilpo1(ip))/ & !gswp1 (ficap1(ip)-wilpo1(ip)) !gswp1 Dsnow(ip) = Dsnow(ip) + sibio%snoww(2)*1000.0 !gswp1 Dskin(ip) = Dskin(ip) + sibio%radsav(12) !gswp1 !** Water Balance Terms !gswp1 Dppl(ip) = Dppl(ip) + sibio%tprec*madtt*nadtt !gswp1 Dexc(ip) = Dexc(ip) + sibio%excinf*1000.0*madtt*nadtt !gswp1 Droff(ip) = Droff(ip) + sibio%roff*1000.0*madtt*nadtt !gswp1 Dmelt(ip) = Dmelt(ip) + sibio%szmelt*1000.0*madtt*nadtt !gswp1 Dtrnsp(ip) = Dtrnsp(ip)+ sibio%etrnsp*madtt*nadtt !gswp1 Dsoile(ip) = Dsoile(ip)+ sibio%esoile*madtt*nadtt !gswp1 Dsnev(ip) = Dsnev(ip) + (sibio%eintrc-sibio%ecane)*madtt*nadtt !gswp1 Dintrc(ip) = Dintrc(ip)+ sibio%ecane *madtt*nadtt !gswp1 Dett(ip) = Dett(ip) + sibio%etmass*madtt*nadtt !gswp1 !gswp1 !** Heat balance !gswp1 Dswd(ip) = Dswd(ip) + sibio%swdown !gswp1 Dlwd(ip) = Dlwd(ip) + sibio%rnetm sibio%swup = sibio%radn(1,1)*sibio%salb(1,1)+ & sibio%radn(1,2)*sibio%salb(1,2)+ & sibio%radn(2,1)*sibio%salb(2,1)+ & sibio%radn(2,2)*sibio%salb(2,2) IF ((sibio%swdown > 0.1).AND.(sibio%swup > 0.1)) THEN ELSE sibio%swup = 0.0 ENDIF !gswp1 Dswu(ip) = Dswu(ip) + sibio%swup !gswp1 Dlwu(ip) = Dlwu(ip) + sibio%zlwup !gswp1 Dshf(ip) = Dshf(ip) + sibio%hflux !gswp1 Dlhf(ip) = Dlhf(ip) + sibio%etlhf !gswp1 Dsnm(ip) = Dsnm(ip) + sibio%ezmelt !gswp1 Dghf(ip) = Dghf(ip) + sibio%shf+sibio%chf !gswp1 !gswp1 !** Diagnostics !gswp1 Drcc(ip) = Drcc(ip) + 1/sibio%rst(1) !gswp1 Draa(ip) = Draa(ip) + 1/sibio%xtem1 !gswp1 Dstres(ip) = Dstres(ip) + sibio%drag !gswp1 !gswp1 Dvcov1(ip) = Dvcov1(ip) + sibio%vcover(1) ! Fraction of vegetation cover !gswp1 Dvcov2(ip) = Dvcov2(ip) + sibio%vcover(2) !gswp1 Dzlt1(ip) = Dzlt1(ip) + sibio%zlt(1) ! Leaf area index !gswp1 Dzlt2(ip) = Dzlt2(ip) + sibio%zlt(2) !gswp1 !gswp1 !** Residuals !gswp1 Deltcs(ip) = sibio%epinf - sibio%ecane !gswp1 Delsd(ip) = sibio%esnowf - sibio%szmelt !gswp1 Deltsw(ip) = sibio%tprec - sibio%epinf + sibio%szmelt - & !gswp1 (sibio%etmass-sibio%ecane)-sibio%roff*1000.0 !gswp1 Delh2o(ip) = (sibio%totwb - sibio%endwb)*1000.0 !** write hourly values to ascii and binary output files ! if it is a designated point! !DO l = 1, npoint ! IF ((iindex(ip) == ixx(l)).AND.(jindex(ip) == iyy(l))) THEN ! j = nhh + 1 ! IF (j == 25) j = 1 ! Ptc(j,l) = Ptc(j,l) + sibio%tc ! Ptg(j,l) = Ptg(j,l) + sibio%tgs ! Ptsn(j,l) = Ptsn(j,l) + sibio%tgs ! Pskin(j,l) = Pskin(j,l) + sibio%radsav(12) ! Pswd(j,l) = Pswd(j,l) + sibio%swdown ! Plwd(j,l) = Plwd(j,l) + sibio%rnetm ! Pswu(j,l) = Pswu(j,l) + sibio%swup ! Plwu(j,l) = Plwu(j,l) + sibio%zlwup ! Pshf(j,l) = Pshf(j,l) + sibio%hflux ! Plhf(j,l) = Plhf(j,l) + (sibio%etmass*(3150.19-2.378*sibio%tm))/3.6 ! Psnm(j,l) = Psnm(j,l) + sibio%ezmelt ! Prcc(j,l) = Prcc(j,l) + 1/sibio%rst(1) ! Praa(j,l) = Praa(j,l) + 1/sibio%xtem1 ! Pstres(j,l) = Pstres(j,l) + sibio%drag ! ENDIF !ENDDO !nf ALMA forcing input A_SWdown(ip) = A_SWdown(ip) + sibio%swdown A_LWdown(ip) = A_LWdown(ip) + sibio%rnetm A_RainfF(ip) = A_RainfF(ip) + (sibio%ppl - sibio%snowfall) / dtt A_SnowfF(ip) = A_SnowfF(ip) + sibio%snowfall / dtt A_Wind (ip) = A_Wind (ip) + sibio%um A_Tair (ip) = A_Tair (ip) + sibio%tm A_Qair (ip) = A_Qair (ip) + sibio%em / sibio%psur * 0.622 A_Psurf (ip) = A_Psurf (ip) + sibio%psur * 100.0 !nf ALMA standard output registers !ALMA O.1 A_SWnet(ip) = A_SWnet(ip) + (sibio%swdown - sibio%swup) A_LWnet(ip) = A_LWnet(ip) + (sibio%rnetm - sibio%zlwup) A_Qle (ip) = A_Qle (ip) + sibio%etlhf A_Qh (ip) = A_Qh (ip) + sibio%hflux A_Qg (ip) = A_Qg (ip) + sibio%shf + sibio%chf + sibio%pcpflx A_Qf (ip) = A_Qf (ip) + sibio%ezmelt A_Qv (ip) = A_Qv (ip) + sibio%esnev A_Qa (ip) = A_Qa (ip) + sibio%pcpflx A_DelSurfHeat(ip) = A_DelSurfHeat(ip) & + ( (sibio%swdown - sibio%swup) + (sibio%rnetm - sibio%zlwup) & - (sibio%etlhf - sibio%esnev) - sibio%hflux & - (sibio%shf + sibio%chf) + sibio%ezmelt ) * dtt A_DelColdCont(ip) = A_DelColdCont(ip) & + ( - sibio%esnev - sibio%ezmelt ) * dtt ! A_DelColdCont(ip) = A_DelColdCont(ip) + sibio%dcoco !ALMA O.2 A_Rainf (ip) = A_Rainf (ip) + (sibio%ppl - sibio%snowfall) / dtt A_Snowf (ip) = A_Snowf (ip) + sibio%snowfall / dtt A_Evap(ip) = A_Evap(ip) + sibio%etmass / dtt A_Qs (ip) = A_Qs (ip) + sibio%excinf*1000.0 / dtt A_Qsb (ip) = A_Qsb (ip) + (sibio%roff - sibio%excinf)*1000.0 / dtt if (sibio%szmelt .ge. 0.0) then A_Qsm (ip) = A_Qsm (ip) + sibio%szmelt*1000.0 / dtt else A_Qfz (ip) = A_Qfz (ip) - sibio%szmelt*1000.0 / dtt endif A_Qst (ip) = A_Qst (ip) + 0.0 A_DelSoilMoist(ip) = A_DelSoilMoist(ip) + 1000.0 * & ( sibio%wwwdt(1) * sibio%porosd(1) * sibio%zdepth(1) & + sibio%wwwdt(2) * sibio%porosd(2) * sibio%zdepth(2) & + sibio%wwwdt(3) * sibio%porosd(3) * sibio%zdepth(3) ) A_DelSWE (ip) = A_DelSWE (ip) + sibio%capacdt(2) * 1000.0 A_DelSurfStor (ip) = A_DelSurfStor (ip) + 0.0 A_DelIntercept(ip) = A_DelIntercept(ip) + sibio%capacdt(1) * 1000.0 !ALMA O.3 if (sibio%capac(2) > 0.00001) then A_SnowT (ip) = sibio%tgs else A_SnowT (ip) = missing endif A_VegT (ip) = sibio%tc A_BareSoilT (ip) = sibio%tgs A_AvgSurfT (ip) = sibio%tc * sibio%vcover(1) + sibio%tgs * (1.0 - sibio%vcover(1)) A_RadT (ip) = sibio%radsav(12) A_Alb_SWdown(ip) = A_Alb_SWdown(ip) + sibio%swdown A_Albedo (ip) = A_Albedo (ip) + sibio%swup !if (sibio%swdown .gt. 0.0) then ! A_Albedo (ip) = sibio%swup / sibio%swdown !else ! A_Albedo (ip) = missing !endif A_SWE (ip) = sibio%capac(2) * 1000.0 A_SurfStor (ip) = 0.0 !ALMA O.4 do i=1,idp wws(i) = sibio%www(i)*sibio%porosd(i)*sibio%zdepth(i)*1000.0 A_SoilMoist (ip,i) = wws(i) A_SoilTemp (ip,i) = sibio%tsoil(i) A_SMLiqFrac (ip,i) = missing A_SMFrozFrac(ip,i) = missing enddo A_SoilWet (ip) = (wws(1)+wws(2)+wws(3)-wilpo2(ip)) & / (fscap2(ip)-wilpo2(ip)) !ALMA O.5 A_PotEvap (ip) = A_PotEvap (ip) + (sibio%pect + sibio%pegs) / dtt A_ECanop (ip) = A_ECanop (ip) + sibio%ecane / dtt A_TVeg (ip) = A_TVeg (ip) + sibio%etrnsp / dtt A_Esoil (ip) = A_Esoil (ip) + sibio%esoile / dtt A_Ewater (ip) = A_Ewater (ip) + 0.0 A_RootMoist (ip) = wws(1) + wws(2) A_CanopInt (ip) = sibio%capac(1) * 1000.0 A_EvapSnow (ip) = A_EvapSnow (ip) + 0.0 A_SubSnow (ip) = A_SubSnow (ip) + (sibio%eintrc-sibio%ecane) / dtt A_SubSurf (ip) = A_SubSurf (ip) + 0.0 A_ACond (ip) = 1.0 / sibio%xtem1 !ALMA O.7 A_SnowFrac (ip) = sibio%snwfrc A_SAlbedo (ip) = sibio%esnalb if (sibio%capac(2) > 0.00001) then A_SnowTProf (ip) = sibio%tgs else A_SnowTProf (ip) = missing endif A_SnowDepth (ip) = sibio%capac(2) * 5.0 A_SliqFrac (ip) = 0.0 !Add RFR Prognostic and Output Variables IF(rfrflag == 1) THEN FOUT_LAND(ip) = FOUT_LAND(ip) + rfrio%FOUT_LAND DISCHARGE(ip) = DISCHARGE(ip) + rfrio%DISCHARGE VELOCITY(ip) = VELOCITY(ip) + rfrio%VELOCITY SW_STORE(ip) = rfrio%SW_STORE GW_OUTFLOW(ip) = GW_OUTFLOW(ip) + rfrio%GW_OUTFLOW GW_STORE(ip) = rfrio%GW_STORE A_FOUT_LAND(ip) = A_FOUT_LAND(ip) + rfrio%FOUT_LAND A_DISCHARGE(ip) = A_DISCHARGE(ip) + rfrio%DISCHARGE A_VELOCITY(ip) = A_VELOCITY(ip) + rfrio%VELOCITY A_SW_STORE(ip) = A_SW_STORE(ip) + rfrio%SW_STORE A_GW_OUTFLOW(ip) = A_GW_OUTFLOW(ip) + rfrio%GW_OUTFLOW A_GW_STORE(ip) = A_GW_STORE(ip) + rfrio%GW_STORE YESTERDAYS_GW_OUTFLOW(ip) = rfrio%YESTERDAYS_GW_OUTFLOW YESTERDAYS_GW_STORE(ip) = rfrio%YESTERDAYS_GW_STORE YESTERDAYS_SW_STORE(ip) = rfrio%YESTERDAYS_SW_STORE YESTERDAYS_SW_OUTFLOW(ip) = rfrio%YESTERDAYS_SW_OUTFLOW YESTERDAYS_SW_INFLOW(ip) = rfrio%YESTERDAYS_SW_INFLOW YESTERDAYS_DEPTH(ip) = rfrio%YESTERDAYS_DEPTH ENDIF END SUBROUTINE drv_postproc