Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Plastic Mulch implementation #114

Merged
merged 6 commits into from
Aug 6, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion InputModule/COMIBS.blk
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@
REAL ICWD,ICRES,ICREN,ICREP,ICRIP,ICRID
REAL HPC(3),HBPC(3)
REAL CHAMT(NAPPL),CHDEP(NAPPL),TDEP(NAPPL)
REAL PMALB !Albedo of plastic bed cover

COMMON /IBS01/ PLME,PLDS,DFDRN,FLST,
& FLDNAM,ISIMI,TITSIM,IOFF,IAME,
Expand Down Expand Up @@ -66,4 +67,4 @@
& CHAMT,CHDEP,TDEP,SPRLAP

COMMON /IBS04/ TOTNAP,RESAMT,TOTAPW,WTHADJ,SLDP,
& ICWD,ICRES,ICREN,ICREP,ICRIP,ICRID
& ICWD,ICRES,ICREN,ICREP,ICRIP,ICRID,PMALB
10 changes: 5 additions & 5 deletions InputModule/OPTEMPXY2K.for
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ C=======================================================================
& FILEIO,FROP,ECONO,ATLINE,
& LNSIM,LNCU,LNHAR,LNENV,LNTIL,LNCHE,
& LNFLD,LNSA,LNIC,LNPLT,LNIR,LNFER,LNRES,
& NFORC,PLTFOR,PMTYPE,NDOF,CHEXTR, MODEL, PATHEX)
& NFORC,PLTFOR,PMTYPE,NDOF,CHEXTR, MODEL, PATHEX, PMWD)

USE ModuleDefs
IMPLICIT NONE
Expand All @@ -69,7 +69,7 @@ C=======================================================================
INTEGER LN

REAL SWINIT(NL),WRESR,WRESND,EFINOC,EFNFIX,INO3(NL),INH4(NL)
REAL PLTFOR
REAL PLTFOR, PMWD
INTEGER LNSIMTMP,TVILENT

PARAMETER (LUNIO = 21)
Expand Down Expand Up @@ -385,11 +385,11 @@ C
C-----------------------------------------------------------------------
WRITE (LUNIO,'(/,"*FIELDS")')
WRITE(LUNIO,'("@L ID_FIELD WSTA.... FLSA FLOB FLDT FLDD",
& 2X,"FLDS FLST SLTX SLDP ID_SOIL")')
& 2X,"FLDS FLST SLTX SLDP ID_SOIL PMWD PMALB")')
WRITE(LUNIO,57,IOSTAT=ERRNUM) LNFLD,FLDNAM,FILEW(1:8),SLOPE,
& FLOB, DFDRN,FLDD,SFDRN,FLST,SLTX,SLDP,SLNO
& FLOB, DFDRN,FLDD,SFDRN,FLST,SLTX,SLDP,SLNO,PMWD,PMALB
57 FORMAT(I3,1X,A8,1X,A8,1X,F5.1,1X,F5.0,1X,A5,2(1X,F5.0),
& 2(1X,A5),1X,F5.0,1X,A10)
& 2(1X,A5),1X,F5.0,1X,A10,1X,F5.1,F6.2)

WRITE(LUNIO,'("@L XCRD YCRD ",
& "ELEV AREA SLEN FLWR SLAS PRMGT")')
Expand Down
8 changes: 4 additions & 4 deletions InputModule/input_sub.for
Original file line number Diff line number Diff line change
Expand Up @@ -125,7 +125,7 @@ C-SUN INTEGER LNBLNK
REAL INO3(NL),INH4(NL),EFINOC,EFNFIX
REAL AINO3,AINH4,TNMIN,ANO3,ANH4,TSWINI
REAL ESW(NL),SW(NL),TLL,TSW,TDUL,TSAT,TPESW,CUMDEP,PESW
REAL PLTFOR
REAL PLTFOR, PMBD

TYPE (ControlType) CONTROL
TYPE (SwitchType) ISWITCH
Expand Down Expand Up @@ -184,7 +184,7 @@ C-----------------------------------------------------------------------
& IIRV,FTYPEN,CHEXTR,NFORC,PLTFOR,NDOF,PMTYPE,
& LNSIM,LNCU,LNHAR,LNENV,LNTIL,LNCHE,
& LNFLD,LNSA,LNIC,LNPLT,LNIR,LNFER,LNRES,
& CONTROL, ISWITCH, UseSimCtr, MODELARG)
& CONTROL, ISWITCH, UseSimCtr, MODELARG, PMBD)

C-----------------------------------------------------------------------
C Call IPSOIL
Expand Down Expand Up @@ -320,14 +320,14 @@ C-----------------------------------------------------------------------
& YRIC,PRCROP,WRESR,WRESND,EFINOC,EFNFIX,
& SWINIT,INH4,INO3,NYRS,VARNO,VRNAME,CROP,MODEL,
& RUN,FILEIO,EXPN,ECONO,FROP,TRTALL,TRTN,
& CHEXTR,NFORC,PLTFOR,NDOF,PMTYPE,ISENS)
& CHEXTR,NFORC,PLTFOR,NDOF,PMTYPE,ISENS,PMBD)

CALL OPTEMPXY2K (YRIC,PRCROP,WRESR,WRESND,EFINOC,EFNFIX,
& SWINIT,INH4,INO3,NYRS,VARNO,VRNAME,CROP,
& FILEIO,FROP,ECONO,ATLINE,
& LNSIM,LNCU,LNHAR,LNENV,LNTIL,LNCHE,
& LNFLD,LNSA,LNIC,LNPLT,LNIR,LNFER,LNRES,
& NFORC,PLTFOR,PMTYPE,NDOF,CHEXTR, MODEL, PATHEX)
& NFORC,PLTFOR,PMTYPE,NDOF,CHEXTR, MODEL, PATHEX,PMBD)

C-----------------------------------------------------------------------
C Write DSSAT Format Version 4 Output files
Expand Down
42 changes: 35 additions & 7 deletions InputModule/ipexp.for
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ C=======================================================================
& NFORC,PLTFOR,NDOF,PMTYPE,
& LNSIM,LNCU,LNHAR,LNENV,LNTIL,LNCHE,
& LNFLD,LNSA,LNIC,LNPLT,LNIR,LNFER,LNRES,
& CONTROL, ISWITCH, UseSimCtr, MODELARG)
& CONTROL, ISWITCH, UseSimCtr, MODELARG,PMWD)

USE ModuleDefs
USE ModuleData
Expand Down Expand Up @@ -101,6 +101,7 @@ C=======================================================================
INTEGER TRTNUM, ROTNUM!,FREQ(3),CUHT(3) !NEW FORAGE VARIABLES (DIEGO-2/14/2017)

REAL FLAG,EXP,TRT,PLTFOR,FREQ,CUHT !NEW FORAGE VARIABLES (DIEGO-2/14/2017)
REAL PMWD

LOGICAL FEXIST, UseSimCtr, SimLevel

Expand Down Expand Up @@ -567,8 +568,8 @@ C-----------------------------------------------------------------------
IF (INDEX('FQ',RNMODE) .LE. 0 .OR. RUN == 1) THEN

CALL IPFLD (LUNEXP,FILEX,LNFLD,FLDNAM,WSTA,WSTA1,SLNO,
& SLTX,FLST,SLOPE,DFDRN,FLDD,SFDRN,FLOB,SLDP,
& XCRD,YCRD,ELEV,AREA,SLEN,FLWR,SLAS,FldHist, FHDur)
& SLTX,FLST,SLOPE,DFDRN,FLDD,SFDRN,FLOB,SLDP,PMWD,
& XCRD,YCRD,ELEV,AREA,SLEN,FLWR,SLAS,FldHist, FHDur,PMALB)

C-----------------------------------------------------------------------
C Select soil profile input file
Expand Down Expand Up @@ -1087,8 +1088,8 @@ C HDLAY :
C=======================================================================

SUBROUTINE IPFLD (LUNEXP,FILEX,LNFLD,FLDNAM,WSTA,WSTA1,SLNO,
& SLTX,FLST,SLOPE,DFDRN,FLDD,SFDRN,FLOB,SLDP,
& XCRD,YCRD,ELEV,AREA,SLEN,FLWR,SLAS,FldHist, FHDUR)
& SLTX,FLST,SLOPE,DFDRN,FLDD,SFDRN,FLOB,SLDP,PMWD,
& XCRD,YCRD,ELEV,AREA,SLEN,FLWR,SLAS,FldHist, FHDUR,PMALB)

USE ModuleData
IMPLICIT NONE
Expand All @@ -1101,12 +1102,13 @@ C=======================================================================
CHARACTER*9 CELEV
CHARACTER*10 SLNO
CHARACTER*12 FILEX
CHARACTER*78 MSG(2)
CHARACTER*15 CXCRD, CYCRD
CHARACTER*92 CHARTEST

INTEGER LUNEXP,LNFLD,LN,LINEXP,ISECT,IFIND,ERRNUM,I, FHDUR

REAL FLDD,SFDRN,FLOB,SLDP,SLOPE
REAL FLDD,SFDRN,FLOB,SLDP,SLOPE,PMWD,PMALB
REAL XCRD,YCRD,ELEV,AREA,SLEN,FLWR,SLAS

! Arrays which contain data for printing in SUMMARY.OUT file
Expand Down Expand Up @@ -1150,7 +1152,8 @@ C=======================================================================
IF (SFDRN .LE. 0.0) THEN
SFDRN = 100.
ENDIF

Write(msg(1),'("Plastic mulch cover albedo =",F7.2)') PMALB
call info(1,errkey,msg)
C
C New section
C
Expand Down Expand Up @@ -1211,6 +1214,30 @@ C Send labels and values to OPSUM
C
C End New section

C
C New section (3rd)
C
C Find header and read second line of field information
C
HFNDCH='PMALB'
CALL HFIND(LUNEXP,HFNDCH,LINEXP,IFIND)
IF (IFIND .EQ. 1) THEN
71 CALL IGNORE (LUNEXP,LINEXP,ISECT,CHARTEST)
IF (ISECT .EQ. 1) THEN
READ (CHARTEST,90,IOSTAT=ERRNUM) LN,
& PMWD,PMALB
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEX,LINEXP)
ELSE
CALL ERROR (ERRKEY,2,FILEX,LINEXP)
ENDIF
IF (LN .NE. LNFLD) GO TO 71
ENDIF
IF (PMWD .LE. 0.0) PMWD = -99
IF (PMALB .LE. 0.0) PMALB = -99

C
C End New section (3rd)

REWIND(LUNEXP)

RETURN
Expand All @@ -1224,6 +1251,7 @@ C-----------------------------------------------------------------------
! chp 7/26/2006
! 80 FORMAT (I3,2(F15.0,1X),F9.0,1X,F17.0,3(1X,F5.0))
80 FORMAT (I3,2(A15,1X),A9,1X,F17.0,3(1X,F5.0),1X,A5,I6)
90 FORMAT (I3, F6.0, F6.2)

END SUBROUTINE IPFLD

8 changes: 4 additions & 4 deletions InputModule/optempy2k.for
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ C=======================================================================
SUBROUTINE OPTEMPY2K (RNMODE, FILEX,PATHEX,
& YRIC,PRCROP,WRESR,WRESND,EFINOC,EFNFIX,SWINIT,INH4,INO3,
& NYRS,VARNO,VRNAME,CROP,MODEL,RUN,FILEIO,EXPN,ECONO,FROP,TRTALL,
& TRTN,CHEXTR,NFORC,PLTFOR,NDOF,PMTYPE,ISENS)
& TRTN,CHEXTR,NFORC,PLTFOR,NDOF,PMTYPE,ISENS,PMWD)

USE ModuleDefs
IMPLICIT NONE
Expand All @@ -84,7 +84,7 @@ C=======================================================================
INTEGER NYRS,RUN,I,EXPN,LUNIO,LINIO,ERRNUM,FROP,YRIC,TRTALL
INTEGER TRTN,NFORC,NDOF,PMTYPE,ISENS

REAL PLTFOR
REAL PLTFOR, PMWD
REAL SWINIT(NL),WRESR,WRESND,EFINOC,EFNFIX,INO3(NL),INH4(NL)

PARAMETER (LUNIO = 21)
Expand Down Expand Up @@ -285,7 +285,7 @@ C-----------------------------------------------------------------------
WRITE (LUNIO,40)'*FIELDS '
LINIO = LINIO + 1
WRITE (LUNIO,59,IOSTAT=ERRNUM) FLDNAM,FILEW(1:8),SLOPE,FLOB,DFDRN,
& FLDD,SFDRN,FLST,SLTX,SLDP,SLNO
& FLDD,SFDRN,FLST,SLTX,SLDP,SLNO,PMWD,PMALB
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEIO,LINIO)
WRITE (LUNIO,60,IOSTAT=ERRNUM) XCRD,YCRD,ELEV,AREA,SLEN,FLWR,SLAS
& , FldHist, FHDur
Expand Down Expand Up @@ -752,7 +752,7 @@ C-----------------------------------------------------------------------
56 FORMAT (3X,A2,1X,A6,1X,A16)
!chp 59 FORMAT (3X,A8,1X,A8,1X,F5.1,1X,F5.0,1X,A5,2(1X,F5.0),
59 FORMAT (3X,A8,1X,A8,1X,F5.1,1X,F5.0,1X,A5,1X,F5.0,1X,F5.1,
& 2(1X,A5),1X,F5.0,1X,A10)
& 2(1X,A5),1X,F5.0,1X,A10,1X,F5.1,F6.2)
!chp 60 FORMAT (3X,2(F15.5,1X),F9.2,1X,F17.1,1X,F5.0,2(1X,F5.1))
60 FORMAT (3X,2(F15.10,1X),F9.3,1X,F17.1,1X,F5.0,2(1X,F5.1),1X,A5,I6)
C 61 FORMAT (3X,A2,4X,I5,2(1X,F5.0),2(1X,F5.2),1X,F5.1,1X,F5.0,
Expand Down
21 changes: 20 additions & 1 deletion SPAM/ESR_SoilEvap.for
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,8 @@
REAL A, B, RedFac, SW_threshold
REAL, DIMENSION(NL) :: DLAYR, DS, DUL, LL, MEANDEP
REAL, DIMENSION(NL) :: SWAD, SWTEMP, SW_AVAIL, ES_Coef
LOGICAL PMcover
REAL PMFRACTION

!-----------------------------------------------------------------------
! ProfileType:
Expand All @@ -73,9 +75,11 @@
DUL = SOILPROP % DUL
LL = SOILPROP % LL
NLAYR = SOILPROP % NLAYR
PMcover = SOILPROP % PMcover
PMFRACTION = SOILPROP % PMFRACTION

ES = 0.0

!**********************************************************************
! NEW 4/18/2008
ProfileType = 3 !assume dry profile until proven wet
Expand Down Expand Up @@ -150,6 +154,9 @@

! Limit to negative values (decrease SW)
SWDELTU(L) = AMIN1(0.0, SWDELTU(L))

! Apply the fraction of plastic mulch coverage
SWDELTU(L) = SWDELTU(L) * (1 - PMFRACTION)

! Aggregate soil evaporation from each layer
ES_LYR(L) = -SWDELTU(L) * DLAYR(L) * 10. !mm
Expand All @@ -170,6 +177,18 @@
DO L = NLAYR-1, 1, -1
UPFLOW(L) = UPFLOW(L+1) + ES_LYR(L) / 10. !cm/d
ENDDO

IF (PMCover) THEN
ES = ES * (1 - PMFRACTION)
ES_LYR = ES_LYR * (1 - PMFRACTION)
SWDELTU = SWDELTU * (1 - PMFRACTION)
UPFLOW = UPFLOW * (1 - PMFRACTION)
! DO L = 1, NLAYR
! ES_LYR(L) = ES_LYR(L) * (1 - PMFRACTION)
! SWDELTU(L) = SWDELTU(L) * (1 - PMFRACTION)
! UPFLOW(L) = UPFLOW(L) * (1 - PMFRACTION)
! ENDDO
ENDIF

!-----------------------------------------------------------------------
RETURN
Expand Down
15 changes: 14 additions & 1 deletion SPAM/SOILEV.for
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,8 @@ C 03/30/2000 CHP Keep original value of WINF for export to soil N module
! Calls: ESUP
C=======================================================================
SUBROUTINE SOILEV(DYNAMIC,
& DLAYR, DUL, EOS, LL, SW, SW_AVAIL, U, WINF, !Input
& DLAYR, DUL, EOS, LL, SW, !Input
& SW_AVAIL,U, WINF, SOILPROP, !Input
& ES) !Output

!-----------------------------------------------------------------------
Expand All @@ -48,6 +49,9 @@ C=======================================================================
REAL ES, T
REAL AWEV1, ESX, SWR, USOIL
REAL DLAYR(NL), DUL(NL), LL(NL), SW(NL)
TYPE (SoilType), INTENT(IN) :: SOILPROP !Soil properties
LOGICAL PMcover
REAL PMFRACTION

!***********************************************************************
!***********************************************************************
Expand Down Expand Up @@ -75,6 +79,9 @@ C-----------------------------------------------------------------------
T= (SUMES2/3.5)**2
ENDIF

PMcover = SOILPROP % PMcover
PMFRACTION = SOILPROP % PMFRACTION

!-----------------------------------------------------------------------
! Set air dry water content for top soil layer
SWEF = 0.9-0.00038*(DLAYR(1)-30.)**2
Expand Down Expand Up @@ -162,6 +169,12 @@ C-----------------------------------------------------------------------
ES = SWMIN * DLAYR(1) * 10.
ENDIF
ES = MAX(ES, 0.0)


! Apply the fraction of plastic mulch coverage
IF (PMCover) THEN
ES = ES * (1 - PMFRACTION)
ENDIF

!***********************************************************************
!***********************************************************************
Expand Down
4 changes: 2 additions & 2 deletions SPAM/SPAM.for
Original file line number Diff line number Diff line change
Expand Up @@ -190,7 +190,7 @@ C=======================================================================
CASE ('R') !Original soil evaporation routine
CALL SOILEV(SEASINIT,
& DLAYR, DUL, EOS, LL, SW, SW_AVAIL(1), !Input
& U, WINF, !Input
& U, WINF,SOILPROP, !Input
& ES) !Output
! ----------------------------
! CASE ('S') !SALUS soil evaporation routine
Expand Down Expand Up @@ -359,7 +359,7 @@ C and total potential water uptake rate.
ENDDO
CALL SOILEV(RATE,
& DLAYR, DUL, EOS_SOIL, LL, SW, !Input
& SW_AVAIL(1), U, WINF, !Input
& SW_AVAIL(1), U, WINF, SOILPROP, !Input
& ES) !Output

! ------------------------
Expand Down
Loading