C HFD, 20230329, fixed duplicated DIMENSION atributes; C Renamed subroutine to avoid conflict with common block name C HFD, 20230405: code adapted to process dynamic land cover and LAI C At this point, only US region, US_XX clim scenario are supported C HFD, 20230407: all variables are now explicitly declared C HFD, 20230410: changed order of COMMON/CELLINFO/ vars (integers to the end) C This is to avoid potential problems when compiling with C -fdefault-real-8 flag C**********************************************************************C C C C *** SUBROUTINE OUTPUT *** C C WRITE MONTHLY WATER BALANCE OUTPUT TO MONTHRUNOFF.TXT C C WRITE MONTHLY SOIL STORAGE OUTPUT TO SOILSTORAGE.TXT C C CALCULATE TOTAL ANNUAL RAIN, PET, AET, DISCHARGE, INT, SNOWP C C PRINT ANNUAL WATER BALANCE COMPONENTS TO ANNUALFLOW.TXT C C C C C C**********************************************************************C SUBROUTINE OUTPUTSR (I, J) IMPLICIT NONE COMMON/BASIC/NGRID,NYEAR,NLC,BYEAR,IYSTART,IYEND,POP_FLAG, & REGION,CLIMATE_FLAG COMMON/OUTPUT/ PET(200,12,10),APET(12),PAET(200,12,10),APAET(12), &AET(12), AVUZTWC(12), AVUZFWC(12), AVLZTWC(12), AVLZFPC(12), &AVLZFSC(12),RO(2200,200,12) COMMON/SUMMARY/ANURAIN(200),ANURUN(200),ANUPET(200),ANUAET(200), &ANUSOIL(200),ANUTEMP(200) COMMON/SOIL/LZTWM(2200), LZFPM(2200), LZFSM(2200), LZSK(2200), > LZPK(2200), UZTWM(2200), UZFWM(2200), UZK(2200), ZPERC(2200), > REXP(2200), PFREE(2200), SMC(12) COMMON/CELLINFO/LADUSE(4000,200,10),LATUDE(4000),LONGI(4000), & TAREA(4000),HUCNO(4000) COMMON/CLIMATE/ RAIN(4000,200,12), TEMP(4000,200, 12) COMMON/FLOW/ STRFLOW(2200, 200, 12) COMMON/SNOWPACK/SP(12), SNOWPACK, ANUMAXSWE(200) COMMON/HUCPETAET/HUCAET(2200,200), HUCPET(2200,200) COMMON/R/ RFACTOR(200) C ----------------------------------------------------------------------------- REAL LADUSE,RAIN, APET, AET, >SMC,STRFLOW, RO,TEMP REAL TANURAIN, TANUPET,TANUAET,TANURUN,TANUSOIL,MEANTEMP REAL ANURAIN,ANUPET,ANUAET, ANURUN REAL ARUNRT(200), AETRT(200), ANUSOIL,ANUTEMP REAL PERCSAT, UZTWM,UZFWM,LZTWM, &LZFSM,LZFPM REAL TDM, TSP, AETPETR, AAETPETR REAL TSNOWP, SP, MAXSWE, ANUMAXSWE REAL HUCAET, HUCPET REAL AVUZTWC, AVUZFWC, AVLZTWC, AVLZFPC, &AVLZFSC INTEGER HUCNO, BYEAR, IDY CHARACTER*5 CLIMATE_FLAG CHARACTER*2 REGION REAL WBCLOS REAL RAINSQ, F, RFACTOR,RFACTOR_AN(200) !Previously undeclared INTEGER I, J, IM, ISM, IYEND, IYSTART, NGRID, NYEAR, POP_FLAG, & NLC REAL APAET, ETRATIO, LATUDE, LONGI, TAREA, LZPK, LZSK, & PFREE, REXP, UZK, ZPERC, PAET, PET, SNOWPACK C-----IDY = THE CALANDER YEAR, BYEAR = YEAR TO SATRT IDY = J + BYEAR - 1 TANURAIN =0. TANUPET= 0. TANUAET= 0. TANURUN= 0. TANUSOIL= 0. TSNOWP = 0. MEANTEMP=0. ISM = 0 TSP = 0. TDM = 0. MAXSWE = 0. ANUMAXSWE(J)=0. RAINSQ =0. C----ONLY WRITE OUTPUT FOR YEARS AFTER THE MODEL WARMUP PERIOD IF(J.GT.(IYSTART-BYEAR)) THEN DO 100 IM = 1, 12 C------PRINT MONTHLY WATER BALANCE DATA TO MONTHRUNOFF.TXT AETPETR=AET(IM)/APET(IM) PERCSAT=SMC(IM)/(UZTWM(I)+UZFWM(I)+LZTWM(I)+LZFSM(I)+LZFPM(I)) c WBCLOS=(RAIN(I,J,IM)-AET(IM)-RO(I,J,IM))- c &(SMC(IM)-SMC(IM-1)+SP(IM)-SP(IM-1)) WRITE (78,2025) HUCNO(I), IDY, IM, RAIN(I,J,IM),PERCSAT, &SP(IM),APET(IM), APAET(IM),AET(IM), AETPETR, RO(I,J,IM) 2025 FORMAT(I10,',',I10,',',I10,',',F10.1,',',F10.2,',', &F10.1,',',F10.1,',',F10.1,',',F10.1,',',F10.1,',',F10.1) C------SUM THE TOTAL RAIN, PET, AET, DISCHARGE, INT, SNOWP FOR YEAR TANURAIN = TANURAIN + RAIN(I,J,IM) TANUPET = TANUPET + APET(IM) TANUAET = TANUAET + AET(IM) TANURUN = TANURUN + RO(I,J,IM) TANUSOIL = TANUSOIL + SMC(IM) TSNOWP = TSNOWP + SP(IM) MEANTEMP = MEANTEMP+TEMP(I,J,IM) IF (SP(IM) .GT. MAXSWE) THEN MAXSWE=SP(IM) ENDIF RAINSQ= RAINSQ + RAIN(I,J,IM)**2 100 CONTINUE C------ASSIGN TOTAL ANNUAL RAIN, PET, AET, DISCHARGE, INT, SNOWP ANURAIN(J) = TANURAIN ANUPET(J) = TANUPET ANUAET(J) = TANUAET ANURUN(J) = TANURUN ANUSOIL(J) = (TANUSOIL/12)/(UZTWM(I)+UZFWM(I)+LZTWM(I)+LZFSM(I) &+LZFPM(I)) ANUTEMP(J)=MEANTEMP/12 ANUMAXSWE(J)=MAXSWE IF (TANURAIN .GE. 1.0) THEN ARUNRT(J) = TANURUN/TANURAIN AETRT(J) = TANUAET/TANURAIN ELSE ARUNRT (J) = 0.0 AETRT (J) = 0.0 ENDIF AAETPETR = ANUAET(J)/ANUPET(J) ETRATIO = AETRT(J) + ARUNRT(J) HUCAET(I,J) = ANUAET(J) HUCPET(I,J) = ANUPET(J) C------PRINT ANNUAL WATER BALANCE COMPONENTS TO ANNUALRUNOFF.TXT C ---- CALCULATING R FACTOR IF (TANURAIN .NE. 0.) THEN F = RAINSQ/TANURAIN IF (F .LT. 55) THEN RFACTOR (J) = (0.07397 * F**1.847 )/17.02 ELSE RFACTOR (J) = (95.77-6.081*F+0.4770*F**2) /17.02 ENDIF ELSE RFACTOR(J) =0. ENDIF IF (TANURAIN.LE.850) THEN RFACTOR_AN(J)=(0.04830 * (TANURAIN**(1.610)))/17.02 ELSE RFACTOR_AN(J)=(587.8 - 1.219*TANURAIN + 0.004105*TANURAIN**2) &/17.02 ENDIF WRITE (79,2100) HUCNO(I), IDY, ANURAIN(J),ANUSOIL(J), > ANUPET(J), ANUAET(J), AAETPETR, ANURUN(J), ARUNRT(J), AETRT(J), > ETRATIO,ANUMAXSWE(J) c--debug---------------------------------------------------------------- c if(I.eq.658) write(*,*) (RO(I,J,IM),IM=1,12) c--debug---------------------------------------------------------------- 2100 FORMAT(I10,',',I10,',',F10.1,',',F10.2,',',F10.1,',',F10.1, &',',F10.2,',',F10.1,',',F10.2,',',F10.2,',',F10.2,',',F10.1) WRITE(81,2101) HUCNO(I),IDY,ANURAIN(J),RFACTOR (J), &RFACTOR_AN(J) 2101 FORMAT(I10,',',I10,',',F10.1,',',F8.1,',',F8.1) ENDIF RETURN END