From 4efa2fb6c3ad8b58d71e57931012c1061b08544a Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Tue, 13 Feb 2024 15:41:24 -0800 Subject: [PATCH 01/55] Changes introduced with feature/SM_irrigation_model to the parent (old) develop branch are integrated into this branch which is up to date with the current develop --- .../GEOSland_GridComp/CMakeLists.txt | 1 + .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 100 +- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 78 +- .../GEOSirrigation_GridComp/CMakeLists.txt | 13 + .../GEOS_IrrigationGridComp.F90 | 852 ++++++++++++++++++ .../irrigation_model.F90 | 678 ++++++++++++++ .../GEOSland_GridComp/Shared/lsm_routines.F90 | 235 +---- .../Shared/GEOS_SurfaceGridComp.rc | 46 +- 8 files changed, 1748 insertions(+), 255 deletions(-) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt index 3870c429b..9564c8928 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt @@ -7,6 +7,7 @@ set (alldirs GEOSlana_GridComp GEOSroute_GridComp GEOSigni_GridComp + GEOSirrigation_GridComp ) esma_add_library (${this} diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 1d68bb3f2..5f6a76c77 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -16,7 +16,8 @@ module GEOS_LandGridCompMod ! Furthermore, several exports of the Vegdyn routines are also exports ! from the Land composite, for use in other modules, such as the case ! for lai and grn needed in radiation. Vegdyn will be updated first. -! Then the catchment call will be issued. The composite exports +! Then the catchment call will be issued. Then the catchment call will be issued. IrrigationGridComp +! was added to compute IRRIGRATE IMPORT required by land models. The composite exports ! consist of the union of the catchment exports with a subset of the ! vegdyn exports. All imports and exports are on the prescribed tile ! grid in the (IM, JM)=(NTILES, 1) convention. @@ -27,11 +28,12 @@ module GEOS_LandGridCompMod use ESMF use MAPL - use GEOS_VegdynGridCompMod, only : VegdynSetServices => SetServices - use GEOS_CatchGridCompMod, only : CatchSetServices => SetServices - use GEOS_CatchCNGridCompMod, only : CatchCNSetServices => SetServices - use GEOS_IgniGridCompMod, only : IgniSetServices => SetServices -! use GEOS_RouteGridCompMod, only : RouteSetServices => SetServices + use GEOS_VegdynGridCompMod, only : VegdynSetServices => SetServices + use GEOS_CatchGridCompMod, only : CatchSetServices => SetServices + use GEOS_CatchCNGridCompMod, only : CatchCNSetServices => SetServices + use GEOS_IgniGridCompMod, only : IgniSetServices => SetServices + use GEOS_IrrigationGridCompMod, only : IrrigationSetServices => SetServices + ! use GEOS_RouteGridCompMod, only : RouteSetServices => SetServices implicit none private @@ -45,8 +47,8 @@ module GEOS_LandGridCompMod integer :: VEGDYN - integer, allocatable :: CATCH(:), ROUTE (:), CATCHCN (:) - integer :: LSM_CHOICE, RUN_ROUTE, DO_GOSWIM + integer, allocatable :: CATCH(:), ROUTE (:), CATCHCN (:), IRRIGATION(:) + integer :: LSM_CHOICE, RUN_ROUTE, DO_GOSWIM, RUN_IRRIG integer :: IGNI logical :: DO_FIRE_DANGER @@ -68,7 +70,7 @@ subroutine SetServices ( GC, RC ) ! !DESCRIPTION: The SetServices for the Physics GC needs to register its ! Initialize and Run. It uses the MAPL\_Generic construct for defining ! state specs and couplings among its children. In addition, it creates the -! children GCs (VegDyn, Catch, CatchCN, Route) and runs their respective SetServices. +! children GCs (VegDyn, Catch, CatchCN, Irrigation, Route) and runs their respective SetServices. !EOP @@ -155,6 +157,7 @@ subroutine SetServices ( GC, RC ) SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) call MAPL_GetResource (SCF, RUN_ROUTE, label='RUN_ROUTE:', DEFAULT=0, __RC__ ) + call MAPL_GetResource (SCF, RUN_IRRIG, label='RUN_IRRIG:', DEFAULT=0, __RC__ ) call MAPL_GetResource (SCF, DO_GOSWIM, label='N_CONST_LAND4SNWALB:', DEFAULT=0, __RC__ ) call MAPL_GetResource (SCF, DO_FIRE_DANGER, label='FIRE_DANGER:', DEFAULT=.false., __RC__ ) call ESMF_ConfigDestroy (SCF, __RC__) @@ -195,6 +198,21 @@ subroutine SetServices ( GC, RC ) END SELECT + if(RUN_IRRIG==1) then + allocate (IRRIGATION(NUM_CATCH), stat=status) + if (NUM_CATCH == 1) then + IRRIGATION(1) = MAPL_AddChild(GC, NAME='IRRIGATION', SS=IrrigationSetServices, RC=STATUS) + VERIFY_(STATUS) + else + do I = 1, NUM_CATCH + WRITE(TMP,'(I3.3)') I + GCName = 'ens' // trim(TMP) // ':IRRIGATION' + IRRIGATION(I) = MAPL_AddChild(GC, NAME=GCName, SS=IrrigationSetServices, RC=STATUS) + VERIFY_(STATUS) + end do + end if + end if + ! IF(RUN_ROUTE == 1) THEN ! if (NUM_CATCH == 1) then ! ROUTE(1) = MAPL_AddChild(GC, NAME='ROUTE', SS=RouteSetServices, RC=STATUS) @@ -530,6 +548,10 @@ subroutine SetServices ( GC, RC ) CHILD_ID = CATCH(1), & RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, & + SHORT_NAME = 'IRRLAND', & + CHILD_ID = CATCH(1), & RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, & SHORT_NAME = 'SNOLAND', & CHILD_ID = CATCH(1), & @@ -1066,6 +1088,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'PRLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRLAND', CHILD_ID = CATCHCN(1), RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SNOLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRPARLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) @@ -1319,6 +1343,13 @@ subroutine SetServices ( GC, RC ) endif END SELECT + + if (RUN_IRRIG == 1) then + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPRINKLERRATE', CHILD_ID = IRRIGATION(0),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FLOODRATE', CHILD_ID = IRRIGATION(0),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRIPRATE', CHILD_ID = IRRIGATION(0),RC=STATUS ) ; VERIFY_(STATUS) + end if + ! These are from RUN1 of vegdyn and the first catchment instance call MAPL_AddExportSpec ( GC, & @@ -1346,6 +1377,7 @@ subroutine SetServices ( GC, RC ) CHILD_ID = VEGDYN,& RC=STATUS ) VERIFY_(STATUS) + ! IF(RUN_ROUTE == 1) THEN ! call MAPL_AddExportSpec ( GC, & ! SHORT_NAME = 'QOUTFLOW', & @@ -1354,7 +1386,7 @@ subroutine SetServices ( GC, RC ) ! VERIFY_(STATUS) ! ENDIF - + if (DO_FIRE_DANGER) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FFMC', CHILD_ID = IGNI, __RC__ ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'GFMC', CHILD_ID = IGNI, __RC__ ) @@ -1422,6 +1454,24 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) end if + if (RUN_IRRIG == 1) then + call MAPL_AddConnectivity ( & + GC ,& + SHORT_NAME = (/'POROS ','WPWET ','VGWMAX ','WCRZ '/) ,& + SRC_ID = CATCH(I) ,& + DST_ID = IRRIGATION(I) ,& + RC = STATUS ) + VERIFY_(STATUS) + + call MAPL_AddConnectivity ( & + GC ,& + SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FLOODRATE '/),& + SRC_ID = IRRIGATION(I) ,& + DST_ID = CATCH(I) ,& + RC = STATUS ) + VERIFY_(STATUS) + end if + ! IF(RUN_ROUTE == 1) THEN ! call MAPL_AddConnectivity ( & ! GC ,& @@ -1454,6 +1504,24 @@ subroutine SetServices ( GC, RC ) RC = STATUS ) VERIFY_(STATUS) end if + + if (RUN_IRRIG == 1) then + call MAPL_AddConnectivity ( & + GC ,& + SHORT_NAME = (/'POROS ','WPWET ','VGWMAX ','WCRZ '/) ,& + SRC_ID = CATCH(I) ,& + DST_ID = IRRIGATION(I) ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddConnectivity ( & + GC ,& + SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FLOODRATE '/),& + SRC_ID = IRRIGATION(I) ,& + DST_ID = CATCH(I) ,& + RC=STATUS ) + VERIFY_(STATUS) + end if ! IF(RUN_ROUTE == 1) THEN ! call MAPL_AddConnectivity ( & @@ -1466,6 +1534,17 @@ subroutine SetServices ( GC, RC ) ! VERIFY_(STATUS) ! ENDIF END SELECT + + if (RUN_IRRIG == 1) then + call MAPL_AddConnectivity ( & + GC ,& + SHORT_NAME = (/'LAI '/) ,& + SRC_ID = VEGDYN ,& + DST_ID = IRRIGATION(I) ,& + RC=STATUS ) + VERIFY_(STATUS) + end if + END DO @@ -1482,6 +1561,7 @@ subroutine SetServices ( GC, RC ) if (allocated(CATCH)) deallocate(CATCH) if (allocated(CATCHCN)) deallocate(CATCHCN) + if (allocated(IRRIGATION)) deallocate(IRRIGATION) RETURN_(ESMF_SUCCESS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 1c6a8f66b..1d06aa865 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -743,6 +743,33 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'sprinkler_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'SPRINKLERRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'DRIPRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FLOODRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + ! !INTERNAL STATE: ! if is_offline, some variables ( in the last) are not required @@ -2337,6 +2364,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'IRRLAND', & + LONG_NAME = 'Total_irrigation_land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SNOLAND', & LONG_NAME = 'snowfall_land', & @@ -3715,6 +3751,9 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ity real, dimension(:), pointer :: ASCATZ0 real, dimension(:), pointer :: NDVI + real, dimension(:), pointer :: SPRINKLERRATE + real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FLOODRATE real, dimension(:,:), pointer :: DUDP real, dimension(:,:), pointer :: DUSV @@ -3878,6 +3917,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND + real, dimension(:), pointer :: IRRLAND real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -3958,6 +3998,8 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: LHACC, SUMEV real,pointer,dimension(:) :: FICE1TMP real,pointer,dimension(:) :: SLDTOT + + real,pointer,dimension(:) :: PLS_IN ! real*8,pointer,dimension(:) :: fsum @@ -4279,6 +4321,11 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSWT ,'SSWT' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRIPRATE, 'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FLOODRATE, 'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) + + ! ----------------------------------------------------- ! INTERNAL Pointers ! ----------------------------------------------------- @@ -4421,6 +4468,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP, 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND, 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND, 'PRLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IRRLAND,'IRRLAND', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND, 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND, 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND, 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -4556,7 +4604,7 @@ subroutine Driver ( RC ) allocate(RCONSTIT (NTILES,N_SNOW,N_constit)) allocate(TOTDEPOS (NTILES,N_constit)) allocate(RMELT (NTILES,N_constit)) - + allocate(PLS_IN (NTILES)) debugzth = .false. ! -------------------------------------------------------------------------- @@ -5039,6 +5087,24 @@ subroutine Driver ( RC ) TILEZERO = 0.0 + PLS_IN = PLS + + ! -------------------------------------------------------------------------- + ! Add irrigation model imports + ! -------------------------------------------------------------------------- + + if(CATCH_INTERNAL_STATE%RUN_IRRIG == 1) then + where (SPRINKLERRATE > 0) + PLS_IN = PLS_IN + SPRINKLERRATE + end where + where (DRIPRATE > 0) + RZEXC = RZEXC + DRIPRATE*DT + end where + where (FLOODRATE > 0) + RZEXC = RZEXC + FLOODRATE*DT + end where + endif + call MAPL_TimerOn ( MAPL, "-CATCH" ) #ifdef DBG_CATCH_INPUTS @@ -5058,7 +5124,7 @@ subroutine Driver ( RC ) ! Inputs call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, PLS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PLS_IN, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) @@ -5470,10 +5536,10 @@ subroutine Driver ( RC ) if (ntiles >0) then call CATCHMENT ( NTILES, LONS, LATS ,& - DT,CATCH_INTERNAL_STATE%USE_FWET_FOR_RUNOFF ,& + DT,CATCH_INTERNAL_SuATE%USE_FWET_FOR_RUNOFF ,& CATCH_INTERNAL_STATE%FWETC, CATCH_INTERNAL_STATE%FWETL,& cat_id, VEG, DZSF ,& - PCU , PLS , SNO, ICE, FRZR ,& + PCU , PLS_IN , SNO, ICE, FRZR ,& UUU ,& EVSBT(:,FSAT), DEVSBT(:,FSAT), DEDTC(:,FSAT) ,& @@ -5683,6 +5749,9 @@ subroutine Driver ( RC ) if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT + if(associated(IRRLAND)) then + if (CATCH_INTERNAL_STATE%RUN_IRRIG == 1) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE + endif if(associated(SNOLAND)) SNOLAND = SLDTOT ! note, not just SNO if(associated(DRPARLAND)) DRPARLAND = DRPAR if(associated(DFPARLAND)) DFPARLAND = DFPAR @@ -5910,6 +5979,7 @@ subroutine Driver ( RC ) deallocate(RMELT ) deallocate(FICE1TMP ) deallocate(SLDTOT ) + deallocate(PLS_IN) deallocate(FSW_CHANGE) RETURN_(ESMF_SUCCESS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt new file mode 100644 index 000000000..5bc517e1e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt @@ -0,0 +1,13 @@ +esma_set_this () + +set (srcs + GEOS_IrrigationGridComp.F90 + irrigation_model.F90 + ) + +include_directories (${INC_ESMF}) + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL) +target_include_directories (${this} PUBLIC ${INC_ESMF}) + + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 new file mode 100644 index 000000000..aa2abdc9d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -0,0 +1,852 @@ +! $Id$ + +#include "MAPL_Generic.h" + + +!============================================================================= +module GEOS_IrrigationGridCompMod + +!BOP + +! !MODULE: GEOS_Irrigation -- child to the "Land" gridded component. + +!DESCRIPTION: +! {\tt GEOS\_Irrigation} is a gridded component that performs the +! necessary interpolation to provide refreshed values of the +! dynamic vegetation values prescribed by external data/observations.\\ +! +! Exports from this routine are the instaneous values of the +! irrigation rates from 3 different irrigation methods on tilespace : +! 1) drip, 2) sprinkler and 3) flood. Because Land models (CATCH/CATCHCN) use +! irrigation rates as a water input in water budget calculation, +! All exports and imports are stored on the +! tile grid inherited from the parent routine.\\ +! +! I. Parameter Class 1: Time and spatially dependent parameters +! from a binary data file\\ +! +! The gridded component stores the surrounding observations of +! each parameter in the internal state. All internals are static parameters. +! +! EXPORTS: SPRINKLERRATE, DRIPRATE, FLOODRATE\\ +! +! INTERNALS: IRRIGFRAC, PADDYFRAC, CROPIRRIGFRAC, IRRIGPLANT, IRRIGHARVEST, +! IRRIGTYPE, SPRINKLERFR, DRIPFR, FLOODFR, LAIMIN, LAIMAX\\ +! OPTIONAL INTERNALS: SRATE, DRATE, FRATE\\ +! +! This GC imports soil parameters and root zone soil moisture from land models +! to compute soil moisture state for IRRIGRATE calculation. +! IMPORTS: POROS, WPWET, VGWMAX, WCRZ, LAI \\ +! +! !USES: + + use ESMF + use MAPL + use IRRIGATION_MODULE + + implicit none + private + +! !PUBLIC MEMBER FUNCTIONS: + + public SetServices + + integer :: IRRIG_METHOD, IRRIG_TRIGGER + logical :: RUN_IRRIG + + type IRRIG_WRAP + type (irrig_params), pointer :: PTR => null() + end type IRRIG_WRAP + +contains + +!BOP + +! !IROUTINE: SetServices -- Sets ESMF services for this component + +! !INTERFACE: + + subroutine SetServices ( GC, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component + integer, optional :: RC ! return code + +! !DESCRIPTION: This version uses the MAPL\_GenericSetServices. This function sets +! the Initialize and Finalize services, as well as allocating +! our instance of a generic state and putting it in the +! gridded component (GC). Here we only need to set the run method and +! add the state variable specifications (also generic) to our instance +! of the generic state. This is the way our true state variables get into +! the ESMF\_State INTERNAL, which is in the MAPL\_MetaComp. + +!EOP + +!============================================================================= +! +! ErrLog Variables + + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type(MAPL_MetaComp),pointer :: MAPL=>null() + type(ESMF_Config) :: SCF + character(len=ESMF_MAXSTR) :: SURFRC + + type (irrigation_model), pointer :: IM => null() + type (IRRIG_wrap) :: wrap + +!============================================================================= + +! Begin... + +!------------------------------------------------------------ +! Get my name and set-up traceback handle +!------------------------------------------------------------ + + call ESMF_GridCompGet(GC ,& + NAME=COMP_NAME ,& + RC=STATUS ) + + VERIFY_(STATUS) + + Iam = trim(COMP_NAME) // 'SetServices' + +! ----------------------------------------------------------- +! Get the configuration +! ----------------------------------------------------------- + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) + VERIFY_(STATUS) + +! ----------------------------------------------------------- +! Get runtime switches +! ----------------------------------------------------------- + + call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) + SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) + call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) + call ESMF_ConfigGetAttribute (SCF, label='RUN_IRRIG:' , value=RUN_IRRIG , DEFAULT=.false., __RC__ ) + call ESMF_ConfigGetAttribute (SCF, label='IRRIG_TRIGGER:', value=IRRIG_TRIGGER,DEFAULT=0, __RC__ ) + call ESMF_ConfigGetAttribute (SCF, label='IRRIG_METHOD:' , value=IRRIG_METHOD, DEFAULT=0, __RC__ ) + + call ESMF_ConfigDestroy (SCF, __RC__) + + ! Leave GEOSirrigation_GridComp if RUN_IRRIG == .FALSE. + if(.not. RUN_IRRIG) then + RETURN_(ESMF_SUCCESS) + endif + +! ----------------------------------------------------------- +! Set the the Initialize and Run entry point +! ----------------------------------------------------------- + + call MAPL_GridCompSetEntryPoint (GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS ) + VERIFY_(STATUS) + call MAPL_GridCompSetEntryPoint (GC, ESMF_METHOD_RUN, Run, RC=STATUS) + VERIFY_(STATUS) + +! BOS + +! ----------------------------------------------------------- +! Internal State +! ----------------------------------------------------------- + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'IRRIGFRAC' ,& + LONG_NAME = 'fraction_of_irrigated_cropland' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'PADDYFRAC' ,& + LONG_NAME = 'fraction_of_paddy_cropland' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'CROPIRRIGFRAC' ,& + LONG_NAME = 'Crop_irrigated_fraction' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'IRRIGPLANT' ,& + LONG_NAME = 'DOY_start_planting' ,& + UNITS = 'day' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + UNGRIDDED_DIMS = (/NUM_SEASONS, NUM_CROPS/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'IRRIGHARVEST' ,& + LONG_NAME = 'DOY_end_harvesting' ,& + UNITS = 'day' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + UNGRIDDED_DIMS = (/NUM_SEASONS, NUM_CROPS/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'IRRIGTYPE' ,& + LONG_NAME = 'Preferred_Irrig_method=(0)CONCURRENT_(1)SPRINKLER_(2)DRIP_(3)FLOOD_(negative)AVOID',& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'SPRINKLERFR' ,& + LONG_NAME = 'fraction_of_sprinkler_irrigation' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'DRIPFR' ,& + LONG_NAME = 'fraction_of_drip_irrigation' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'FLOODFR' ,& + LONG_NAME = 'fraction_of_flood_irrigation' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'LAIMIN' ,& + LONG_NAME = 'Minimum_LAI_irrigated_crops' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'LAIMAX' ,& + LONG_NAME = 'Maximum_LAI_irrigated_crops' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + if (IRRIG_TRIGGER == 0) then + ! only two crop types: irrigated crops and paddy in that order. + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'SRATE' ,& + LONG_NAME ='crop_specific_sprinkler_irrigation_rate',& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartOptional ,& + UNGRIDDED_DIMS = (/2/) ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'DRATE' ,& + LONG_NAME = 'crop_specific_drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartOptional ,& + UNGRIDDED_DIMS = (/2/) ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'FRATE' ,& + LONG_NAME = 'crop_specific_flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartOptional ,& + UNGRIDDED_DIMS = (/2/) ,& + RC=STATUS ) + VERIFY_(STATUS) + + elseif (IRRIG_TRIGGER == 1) then + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'SRATE' ,& + LONG_NAME ='crop_specific_sprinkler_irrigation_rate',& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartOptional ,& + UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'DRATE' ,& + LONG_NAME = 'crop_specific_drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartOptional ,& + UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + SHORT_NAME = 'FRATE' ,& + LONG_NAME = 'crop_specific_flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + FRIENDLYTO = trim(COMP_NAME) ,& + RESTART = MAPL_RestartOptional ,& + UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + RC=STATUS ) + VERIFY_(STATUS) + + endif + +! ----------------------------------------------------------- +! Export state +! ----------------------------------------------------------- + + call MAPL_AddExportSpec(GC ,& + SHORT_NAME = 'SPRINKLERRATE' ,& + LONG_NAME = 'sprinkler_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + SHORT_NAME = 'DRIPRATE' ,& + LONG_NAME = 'drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + SHORT_NAME = 'FLOODRATE' ,& + LONG_NAME = 'flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + +! ----------------------------------------------------------- +! Import states +! ----------------------------------------------------------- + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'POROS' ,& + LONG_NAME = 'soil_porosit' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'WPWET' ,& + LONG_NAME = 'wetness_at_wilting_point' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'VGWMAX' ,& + LONG_NAME = 'max_rootzone_water_content' ,& + UNITS = 'kg m-2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'WCRZ' ,& + LONG_NAME = 'water_root_zone' ,& + UNITS = 'm3 m-3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'LAI' ,& + LONG_NAME = 'leaf_area_index' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + +! Allocate this instance of the internal state and put it in wrapper. +! ------------------------------------------------------------------- + + allocate(IM, stat=status ) + VERIFY_(STATUS) + call IM%init_model (SURFRC) + wrap%ptr => IM%irrig_params + +! Save pointer to the wrapped internal state in the GC +! ---------------------------------------------------- + + call ESMF_UserCompSetInternalState ( GC, 'irrigation_state',wrap,status ) + VERIFY_(STATUS) + +! Clocks +!------- + + call MAPL_TimerAdd(GC, name="INITIALIZE" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="RUN" ,RC=STATUS) + VERIFY_(STATUS) + +!------------------------------------------------------------ +! Set generic init and final methods +!------------------------------------------------------------ + + call MAPL_GenericSetServices(GC, RC=STATUS) + VERIFY_(STATUS) + + RETURN_(ESMF_SUCCESS) + + end subroutine SetServices + + ! ----------------------------------------------------------- + ! INITIALIZE -- Initialize method for the irrigation component + ! ----------------------------------------------------------- + + subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) + + ! ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC + type(ESMF_State), intent(inout) :: IMPORT + type(ESMF_State), intent(inout) :: EXPORT + type(ESMF_Clock), intent(inout) :: CLOCK + integer, optional, intent( out) :: RC + + ! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm="Initialize" + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + + ! Locals + + type (MAPL_MetaComp), pointer :: MAPL=>null() + type (ESMF_State ) :: INTERNAL + + ! INTERNAL pointers + + real, dimension(:), pointer :: IRRIGFRAC + real, dimension(:), pointer :: PADDYFRAC + real, dimension(:,:), pointer :: CROPIRRIGFRAC + real, dimension(:,:), pointer :: IRRIGTYPE + real, dimension(:,:), pointer :: SRATE + real, dimension(:,:), pointer :: DRATE + real, dimension(:,:), pointer :: FRATE + +! EXPORT ponters + + real, dimension(:), pointer :: SPRINKLERRATE + real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FLOODRATE + + type(irrigation_model),pointer :: IM + type (IRRIG_wrap) :: wrap + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, RC=STATUS ) + VERIFY_(STATUS) + + Iam = trim(COMP_NAME) // "Initialize" + + call MAPL_GenericInitialize ( GC, import, export, clock, rc=status ) + VERIFY_(STATUS) + call ESMF_UserCompGetInternalState ( GC, 'irrigation_state',wrap,status ) + VERIFY_(STATUS) + allocate (IM) + IM = irrigation_model() + IM%irrig_params = wrap%ptr + + ! Get my internal MAPL_Generic state + ! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, STATUS) + VERIFY_(STATUS) + + call MAPL_TimerOn(MAPL,"INITIALIZE") + + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, RC=STATUS) + VERIFY_(STATUS) + + ! get pointers to internal variables + ! ---------------------------------- + + call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC',RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + + ! get pointers to EXPORT variable + ! ------------------------------- + call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + + ! Update IRRIGFRAC and PADDYFRAC for applications that are run on regular tiles in which IRRIGFRAC and PADDYFRAC in BCs are fractions. + ! The irrigation model would run on tiles whose IRRIGFRAC + PADDYFRAC > IRRIG_THRES (defult is 0.5) assuming the larger + ! of the two fractions is the dominant surface type. + + where (IRRIGFRAC + PADDYFRAC > IM%IRRIG_THRES) + where (PADDYFRAC >= IRRIGFRAC) + PADDYFRAC = 1. + IRRIGFRAC = 0. + elsewhere + PADDYFRAC = 0. + IRRIGFRAC = 1. + endwhere + elsewhere + PADDYFRAC = 0. + IRRIGFRAC = 0. + endwhere + + if (IRRIG_TRIGGER == 0) then + + ! LAI based trigger: scale soil moisture to LAI seasonal cycle + ! ============================================================ + + call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) + + else + + ! crop calendar based irrigation + ! ============================== + + call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + CROPIRRIGFRAC,SRATE,DRATE,FRATE) + + endif + + ! Scale computed SPRINKLERRATE, DRIPRATE, and FLOODRATE to the total + ! irrigated tile fraction before exporting to land models. + ! Since revised IRRIGFRAC, and PADDYFRAC in subtiling mode are 0. or 1., below scaling + ! has no effect in that mode. + + SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC + PADDYFRAC) + DRIPRATE = DRIPRATE *(IRRIGFRAC + PADDYFRAC) + FLOODRATE = FLOODRATE *(IRRIGFRAC + PADDYFRAC) + + call MAPL_TimerOff(MAPL,"INITIALIZE") + RETURN_(ESMF_SUCCESS) + + end subroutine INITIALIZE + +! ----------------------------------------------------------- +! RUN -- Run method for the irrigation component +! ----------------------------------------------------------- + + subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) + +! ----------------------------------------------------------- +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC + type(ESMF_State), intent(inout) :: IMPORT + type(ESMF_State), intent(inout) :: EXPORT + type(ESMF_Clock), intent(inout) :: CLOCK + integer, optional, intent( out) :: RC + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Locals + + type (MAPL_MetaComp), pointer :: MAPL=>null() + type (ESMF_State ) :: INTERNAL + +! INTERNAL pointers + + real, dimension(:), pointer :: IRRIGFRAC + real, dimension(:), pointer :: PADDYFRAC + real, dimension(:), pointer :: SPRINKLERFR + real, dimension(:), pointer :: DRIPFR + real, dimension(:), pointer :: FLOODFR + real, dimension(:), pointer :: LAIMIN + real, dimension(:), pointer :: LAIMAX + real, dimension(:,:), pointer :: CROPIRRIGFRAC + real, dimension(:,:), pointer :: IRRIGTYPE + real, dimension(:,:,:), pointer :: IRRIGPLANT + real, dimension(:,:,:), pointer :: IRRIGHARVEST + real, dimension(:,:), pointer :: SRATE + real, dimension(:,:), pointer :: DRATE + real, dimension(:,:), pointer :: FRATE + +! EXPORT ponters + + real, dimension(:), pointer :: SPRINKLERRATE + real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FLOODRATE + +! IMPORT pointers + + real, dimension(:), pointer :: POROS + real, dimension(:), pointer :: WPWET + real, dimension(:), pointer :: VGWMAX + real, dimension(:), pointer :: WCRZ + real, dimension(:), pointer :: LAI + +! Time attributes + + type(ESMF_Time) :: CURRENT_TIME + integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr + +! Others/ Locals + + type(irrigation_model),pointer :: IM + type (IRRIG_wrap) :: wrap + real,pointer,dimension(:) :: lons + integer :: ntiles, n + real, dimension(:),allocatable :: local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF + real :: DT, T1, T2 + + + ! Get the target components name and set-up traceback handle. + ! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, RC=STATUS ) + VERIFY_(STATUS) + + Iam = trim(COMP_NAME) // "Run" + + call ESMF_UserCompGetInternalState ( GC, 'irrigation_state',wrap,status ) + VERIFY_(STATUS) + allocate (IM) + IM = irrigation_model() + IM%irrig_params = wrap%ptr + + ! Get my internal MAPL_Generic state + ! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, STATUS) + VERIFY_(STATUS) + + call MAPL_Get(MAPL, HEARTBEAT = DT, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_TimerOn(MAPL,"RUN") + + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, RC=STATUS) + VERIFY_(STATUS) + + ! get pointers to internal variables + ! ---------------------------------- + + call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC',RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGPLANT ,'IRRIGPLANT', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGHARVEST ,'IRRIGHARVEST', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, SPRINKLERFR ,'SPRINKLERFR', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, DRIPFR ,'DRIPFR', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, FLOODFR ,'FLOODFR', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, LAIMIN ,'LAIMIN', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, LAIMAX ,'LAIMAX', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + + ! get pointers to EXPORT variable + ! ------------------------------- + call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + + + ! get pointers to IMPORT variables + ! -------------------------------- + + call MAPL_GetPointer(IMPORT, POROS , 'POROS', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, WPWET , 'WPWET', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, VGWMAX , 'VGWMAX', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, WCRZ , 'WCRZ', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, LAI , 'LAI', RC=STATUS) ; VERIFY_(STATUS) + + ! Get time and parameters from local state + ! ---------------------------------------- + + call ESMF_ClockGet ( CLOCK, currTime=CURRENT_TIME, RC=STATUS ) + VERIFY_(STATUS) + + call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YY, & + MM = AGCM_MM, & + DD = AGCM_DD, & + H = AGCM_HH, & + M = AGCM_MI, & + S = AGCM_S , & + dayOfYear = dofyr , & + rc=status ) + VERIFY_(STATUS) + + call MAPL_Get (MAPL, TILELONS = LONS, & + INTERNAL_ESMF_STATE = INTERNAL, RC=STATUS ) + VERIFY_(STATUS) + + + ! call irrigation model + ! --------------------- + + NTILES = SIZE (LONS) + + allocate (local_hour (1:NTILES)) + allocate (SMWP (1:NTILES)) + allocate (SMSAT (1:NTILES)) + allocate (SMREF (1:NTILES)) + allocate (SMCNT (1:NTILES)) + allocate (RZDEF (1:NTILES)) + + ! soil moisture state + SMWP = VGWMAX * WPWET ! RZ soil moisture content at wilting point [mm] + SMSAT = VGWMAX ! RZ soil moisture at saturation [mm] + SMCNT = (VGWMAX/POROS) * WCRZ ! actual RZ soil moisture content [mm] + + DO N = 1, NTILES + + ! local time [hour] + + local_hour(n) = AGCM_HH + AGCM_MI / 60. + AGCM_S / 3600. + 12.* (lons(n)/MAPL_PI) + IF (local_hour(n) >= 24.) local_hour(n) = local_hour(n) - 24. + IF (local_hour(n) < 0.) local_hour(n) = local_hour(n) + 24. + T1 = CEILING (local_hour(n)) - DT/3600. + T2 = FLOOR (local_hour(n) + 1) + DT/3600. + if((local_hour(n) >= T1).and.(local_hour(n) < T2))then + local_hour(n) = real(NINT(local_hour(n))) + end if + + ! The reference soil moisture content is set to lower tercile of RZ soil moisture range [mm] to be consistent + ! with ASTRFR = 0.333 used in CATCH/CATCHCN. + ! Perhaps, soil field capacity (FIELDCAP) is the desired parameter here - the upper limit + ! of water content that soil can hold for plants after excess water drained off downward quickly. + ! If we want to switch to FIELDCAP in the future, that has already been derived on tiles and available + ! in irrigation_IMxJM_DL.dat file. + + SMREF (n) = VGWMAX (n) * (wpwet (n) + (1. - wpwet (n))/2.5) + + ! rootzone moisture deficit to reach complete soil saturation for paddy [mm] + + RZDEF (n) = MAX(SMSAT(n) - SMCNT(n), 0.) + + END DO + + if (IRRIG_TRIGGER == 0) then + + ! LAI based trigger: scale soil moisture to LAI seasonal cycle + ! ============================================================ + + call IM%run_model(IRRIG_METHOD, local_hour, & + IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & + SMWP,SMSAT,SMREF,SMCNT, LAI, LAIMIN, LAIMAX, RZDEF, & + SPRINKLERRATE, DRIPRATE, FLOODRATE, & + SRATE, DRATE, FRATE) + + else + + ! crop calendar based irrigation + ! ============================== + + call IM%run_model (dofyr,local_hour, & + SPRINKLERFR, DRIPFR, FLOODFR, & + CROPIRRIGFRAC,IRRIGPLANT,IRRIGHARVEST,IRRIGTYPE , & + SMWP,SMSAT,SMREF,SMCNT, RZDEF, & + SPRINKLERRATE, DRIPRATE, FLOODRATE, & + SRATE, DRATE, FRATE) + + endif + + ! Scale computed SPRINKLERRATE, DRIPRATE, and FLOODRATE to the total + ! irrigated tile fraction before exporting to land models. + ! Since revised IRRIGFRAC, and PADDYFRAC in subtiling mode are 0. or 1., below scaling + ! has no effect in that mode. + + SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC + PADDYFRAC) + DRIPRATE = DRIPRATE *(IRRIGFRAC + PADDYFRAC) + FLOODRATE = FLOODRATE *(IRRIGFRAC + PADDYFRAC) + + deallocate (local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF, IM) + + call MAPL_TimerOff(MAPL,"RUN") + RETURN_(ESMF_SUCCESS) + + end subroutine RUN + +end module GEOS_IrrigationGridCompMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 new file mode 100644 index 000000000..cbb751e39 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -0,0 +1,678 @@ +#include "MAPL_Generic.h" + +MODULE IRRIGATION_MODULE + + USE MAPL + USE ESMF + + IMPLICIT NONE + + ! This module computes irrigation rates by 3 different methods: sprinkler, flood and drip. + ! Computed irrigation rates return to the land model as rates that water is added to + ! the hydrological cycle by irrigation. Subsequently, land models add irrigation feedback: + ! sprinkler irrigation rate to large scale precipitation; + ! drip irrigation volume to rootzone excess; and + ! flood irrigation volume to rootzone excess. + ! The model uses rootzone soil moisture state at the local start time of irrigation to compute + ! irrigation rates for the day and maintains the same rate through out the irrigation duration. + ! + ! Sprinkler and Flood Irrigation methods were adapted from LIS CLSMF2.5 irrigatrion module: + ! https://github.com/NASA-LIS/LISF/blob/master/lis/surfacemodels/land/clsm.f2.5/irrigation/clsmf25_getirrigationstates.F90 + ! Drip irrigation method calculation is similar to that of sprinkler, albeit the drip irrigation method assumes a 0% water loss. + ! + ! March 21, 2021 (Sarith Mahanama) - First Version + ! + ! (1) EXPORTS - MODEL OUTPUTS TO THE LAND MODEL (IRRIGATION RATES): + ! 1) SPRINKLERRATE [kg m-2 s-1] + ! 2) DRIPRATE [kg m-2 s-1] + ! 3) FLOODRATE [kg m-2 s-1] + ! + ! (2) COMPUTATIONAL TILES: + ! During land BCs generation, land tiles where irrigated crops or paddy is present were further subdivided to a + ! mosaic of upto 3 fractions: i) non-irrigated land, ii) irrigated crop, or iii) paddy. + ! The model treats each fraction as a separate computational tile and runs on each individual fraction with own parameters and prognostics. + ! All fractions inherited model and soil parameters from the main land tile that they belong to. A special treatment of setting BF3 to a high + ! value (25.) was applied to paddy/crop tiles to account for the uniquely flat nature of farmlands. Vegetation characteristics and vegetation dynamic + ! parameters for irrigated crop and paddy tiles were taken from the nearest grass or crops land tile. + ! During tiling and BCs data preparation, computed fractional coverages for land tiles were also adjusted + ! to reflect each computational tile under the land grid component represents entirely one of the 3 irrigation surface types: a non-irrigated land, + ! OR a irrigated-crops OR a paddy tile. + ! + ! (3) MODEL INPUTS: + ! SMWP : rootzone soil moisture content at wilting point [mm] + ! SMSAT : rootzone soil moisture content at saturation [mm] + ! SMREF : rootzone soil moisture is at lower tercile of RZ soil moisture range [mm] + ! SMCNT : currrent root zone soil moisture content [mm] + ! RZDEF : rootzone moisture deficit to reach complete soil saturation for paddy [mm] + ! LOCAL_HOUR to set irrigation switch. + ! + ! (4) SEASONAL CYLCE OF CROP WATER DEMAND: + ! The module provides 2 options to determine the seasonal cycle of crop water demand: + ! 4.1) IRRIG_TRIGGER: 0 - SUBROUTINE irrigrate_lai_trigger + ! The LAI-based trigger (Default and the current LIS implementation) + ! uses precomputed minimum and maximum LAI on irrigateed pixels to determine + ! beginning and end of crop growing seasons. + ! + ! This LAI-based trigger is also equipped with an additional control parameter, IRRIG_METHOD, which is good to choose the method of irrigation + ! that woould run on corresponding fractions + ! i) 0: (Default) All 3 methods (sprinkler/flood/drip) concurrently. + ! ii) 1: Sprinkler irrigation on entire tile. + ! iv) 2: Drip irrigation on entire tile. + ! iii)3: Flood irrigation on entire tile. + ! + ! IRRIG_TRIGGER: 0 SPECIFIC INPUTS: + ! IRRIGFRAC : fraction of tile covered by irrigated crops (per Section 2, values will be 0. or 1.) + ! PADDYFRAC : fraction of tile covered by paddy (per Section 2, values will be 0. or 1.) + ! SPRINKLERFR : fraction of tile equipped for sprinkler irrigation + ! DRIPFR : fraction of tile equipped for drip irrigation + ! FLOODFR : fraction of tile equipped for flood irrigation + ! LAI : time varying Leaf Area Index from the model + ! LAIMIN : Minimum LAI spatially averaged over the irrigated tile fraction + ! LAIMAX : Maximum LAI spatially averaged over the irrigated tile fraction + ! + ! 4.2) IRRIG_TRIGGER: 1 - SUBROUTINE irrigrate_crop_calendar + ! uses 26 crop calendars based on monthly crop growing areas of below crops. + ! 1 Wheat 14 Oil palm + ! 2 Maize 15 Rape seed / Canola + ! 3 Rice 16 Groundnuts / Peanuts + ! 4 Barley 17 Pulses + ! 5 Rye 18 Citrus + ! 6 Millet 19 Date palm + ! 7 Sorghum 20 Grapes / Vine + ! 8 Soybeans 21 Cotton + ! 9 Sunflower 22 Cocoa + ! 10 Potatoes 23 Coffee + ! 11 Cassava 24 Others perennial + ! 12 Sugar cane 25 Fodder grasses + ! 13 Sugar beet 26 Others annual + ! + ! IRRIG_TRIGGER: 1 SPECIFIC INPUTS: + ! DOFYR : day of year + ! IRRIGTYPE : Preferred Irrig method (NTILES, 26) - + ! (0)CONCURRENT (default), (1)SPRINKLER ONLY (2)DRIP ONLY (3)FLOOD ONLY, and (-negative) AVOID this method + ! CROPIRRIGFRAC: Crop irrigated fraction (NTILES, 26) (per Section 2, fractions have been adjusted such that + ! CROPIRRIGFRAC is 1. on paddy tiles; the sum of available crop fractions is 1. on irrigated crop tiles; + ! and is zero on non-irrigated tiles. + ! IRRIGPLANT : DOY start planting (NTILES, 2, 26) - up to two seasons + ! IRRIGHARVEST : DOY end harvesting (NTILES, 2, 26) - up to two seasons + ! If IRRIGPLANT/IRRIGHARVEST = 998, the crop is not grown on that tile + ! + ! (5) MODEL UPDATES (OPTIONAL INTERNALS): + ! SRATE, DRATE, and FRATE contain irrigation rates applied on individual fractions at any given time. + ! The second dimensions of 2D arrays is for different crop fractions i.e. the second dimension is 2 for above + ! IRRIG_TRIGGER: 0 to separately store irrigation rates in irrigated crop and paddy fractions. + ! It would be 26 for IRRIG_TRIGGER: 1. + ! Note also that runnning the irrigation model on subtiling mode (specific irrigated crop and paddy tiles with their own land prognostics) + ! is preferred (Section 2) to running the irrigation model on fractions of typical land tiles. For the subtiling mode with own soil moisture + ! prognostics, IRRIGFRAC, PADDYFRAC and CROPIRRIGFRAC fractions have been adjusted to represent irrigation type of the subtile in question. i.e. + ! IRRIFRAC has been set to 1. on irrigated-crop subtiles; PADDYFRAC and CROPIRRIGFRAC(N,3) are set to 1. on paddy subtiles; and SUM of + ! CROPIRRIGFRAC(N,:) excluding the 3rd element is set to 1. on irrigated crop tiles. + ! + ! The crop calendar implemetation (IRRIG_TRIGGER: 1) computes SPRINKLERRATE, DRIPRATE, and FLOODRATE as weighted averages of irrigation rates from + ! all active crops in SRATE, DRATE and FRATE arrays. + + PRIVATE + + INTEGER, PARAMETER, PUBLIC :: NUM_CROPS = 26, NUM_SEASONS = 2 + + type, public :: irrig_params + + ! Below parameters can be set via RC file. + + REAL :: irrig_thres = 0.5 ! threshold of tile fraction to turn the irrigation model on. + REAL :: lai_thres = 0.6 ! threshold of LAI range to turn irrigation on + REAL :: efcor = 30.0 ! Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use) + REAL :: MIDS_LENGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER: 1) + + ! Sprinkler parameters + ! -------------------- + REAL :: sprinkler_stime = 6.0 ! sprinkler irrigatrion start time [hours] + REAL :: sprinkler_dur = 4.0 ! sprinkler irrigation duration [hours] + REAL :: sprinkler_thres = 0.7 ! soil moisture threshhold to trigger sprinkler irrigation + + ! Drip parameters + ! --------------- + REAL :: drip_stime = 8.0 ! drip irrigatrion start time [hours] + REAL :: drip_dur = 8.0 ! drip irrigation duration [hours] + + ! Flood parameters + ! ---------------- + REAL :: flood_stime = 6.0 ! flood irrigatrion start time [hours] + REAL :: flood_dur = 1.0 ! flood irrigation duration [hours] + REAL :: flood_thres = 0.6 ! soil moisture threshhold to trigger flood irrigation + + + end type irrig_params + + type, public, extends (irrig_params) :: irrigation_model + + contains + + ! public + procedure, public :: init_model + generic, public :: run_model => irrigrate_lai_trigger, irrigrate_crop_calendar + generic, public :: update_irates => update_irates_lai, update_irates_ccalendar + + ! private + procedure, private :: irrigrate_lai_trigger + procedure, private :: irrigrate_crop_calendar + procedure, private :: cwd => crop_water_deficit + procedure, private :: irrig_by_method + procedure, private :: update_irates_lai + procedure, private :: update_irates_ccalendar + + end type irrigation_model + +contains + + ! ---------------------------------------------------------------------------- + + SUBROUTINE init_model (IP, SURFRC) + + implicit none + class (irrigation_model), intent(inout) :: IP + type(irrig_params) :: DP + CHARACTER(*), INTENT(IN) :: SURFRC + type(ESMF_Config) :: SCF + integer :: status, RC + character(len=ESMF_MAXSTR) :: Iam + + Iam='IRRIGATION_MODULE: init_model' + + SCF = ESMF_ConfigCreate(__RC__) + CALL ESMF_ConfigLoadFile (SCF,SURFRC,rc=status) ; VERIFY_(STATUS) + CALL ESMF_ConfigGetAttribute (SCF, label='SPRINKLER_STIME:', VALUE=IP%sprinkler_stime, DEFAULT=DP%sprinkler_stime, __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='SPRINKLER_DUR:' , VALUE=IP%sprinkler_dur, DEFAULT=DP%sprinkler_dur , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='SPRINKLER_THRES:', VALUE=IP%sprinkler_thres, DEFAULT=DP%sprinkler_thres, __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='DRIP_STIME:' , VALUE=IP%drip_stime, DEFAULT=DP%drip_stime , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='DRIP_DUR:' , VALUE=IP%drip_dur, DEFAULT=DP%drip_dur , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='FLOOD_STIME:' , VALUE=IP%flood_stime, DEFAULT=DP%flood_stime , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='FLOOD_DUR:' , VALUE=IP%flood_dur, DEFAULT=DP%flood_dur , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='FLOOD_THRES:' , VALUE=IP%flood_thres, DEFAULT=DP%flood_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRR_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='LAI_THRES:' , VALUE=IP%lai_thres, DEFAULT=DP%lai_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='MIDS_LENGTH:' , VALUE=IP%MIDS_LENGTH, DEFAULT=DP%lai_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRIG_THRES:' , VALUE=IP%irrig_thres, DEFAULT=DP%irrig_thres , __RC__ ) + CALL ESMF_ConfigDestroy (SCF, __RC__) + + END SUBROUTINE init_model + + ! ---------------------------------------------------------------------------- + + SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & + IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & + SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN,LAIMAX, RZDEF, & + SPRINKLERRATE, DRIPRATE, FLOODRATE, SRATE, DRATE, FRATE) + + implicit none + class (irrigation_model), intent(inout) :: this + integer, intent (in) :: IRRIG_METHOD + real, dimension (:), intent (in) :: local_hour + real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC, SPRINKLERFR, & + DRIPFR, FLOODFR, SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN, LAIMAX, RZDEF + real, dimension (:), intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE + INTEGER :: NTILES, N, crop + REAL :: ma, H1, H2, HC, IT, ROOTFRAC, LAITHRES + logical :: season_end + + NTILES = SIZE (IRRIGFRAC) + TILE_LOOP : DO N = 1, NTILES + IF(LAIMAX (N) > LAIMIN (N)) THEN + LAITHRES = LAIMIN (N) + this%lai_thres * (LAIMAX (N) - LAIMIN (N)) + ROOTFRAC = MIN((LAI(N) - LAIMIN (N)) / (LAIMAX(N) - LAIMIN(N)) ,1.0) + ELSE + ROOTFRAC = 0. + ENDIF + HC = local_hour(n) + + season_end = .true. + + CHECK_LAITHRES : IF (LAI(N) >= LAITHRES) THEN + season_end = .false. + CHECK_IRRIGFRACS: IF (IRRIGFRAC(N) > 0.) THEN + + !----------------------------------------------------------------------------- + ! Get the root zone moisture availability to the plant + !----------------------------------------------------------------------------- + + if(SMREF(N) > SMWP(N))then + ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) + else + ma = -1. + endif + + if(ma >= 0) then + + SELECT CASE (IRRIG_METHOD) + CASE (0) ! CONCURRENTLY SPRINKER + FLOOD + DRIP on corresponding fractions + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + SRATE = SRATE (N,1), & + DRATE = DRATE (N,1), & + FRATE = FRATE (N,1)) + + SRATE (N,1) = SRATE (N,1)*SPRINKLERFR(N) + DRATE (N,1) = DRATE (N,1)*DRIPFR (N) + FRATE (N,1) = FRATE (N,1)*FLOODFR (N) + + CASE (1) ! SPRINKLER only + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + SRATE = SRATE (N,1)) + + DRATE (N,1) = 0. + FRATE (N,1) = 0. + + CASE (2) ! DRIP only + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + DRATE = DRATE (N,1)) + + SRATE (N,1) = 0. + FRATE (N,1) = 0. + + CASE (3) ! FLOOD only + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + FRATE = FRATE (N,1)) + + SRATE (N,1) = 0. + DRATE (N,1) = 0. + + CASE DEFAULT + PRINT *, 'irrigrate_lai_trigger: IRRIG_METHOD can be 0,1,2, or3' + CALL EXIT(1) + END SELECT + endif + + ELSEIF (PADDYFRAC (N) > 0.) THEN + + H1 = this%flood_stime + H2 = this%flood_stime + this%flood_dur + if ((HC >= H1).AND.(HC < H2)) then + ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate for paddy. + if(H1 == HC) FRATE (N,2) = RZDEF(N) *0.1/(H2 - H1)/ 3600. + else + FRATE (N,2) = 0. + endif + SRATE (N,2) = 0. + DRATE (N,2) = 0. + + ELSE + + SRATE (N,:) = 0. + DRATE (N,:) = 0. + FRATE (N,:) = 0. + + ENDIF CHECK_IRRIGFRACS + ENDIF CHECK_LAITHRES + + ! turn off irrigation if LAI is smaller than the LAI trigger marking end of the season + if(season_end) then + DO crop = 1, 2 + SRATE (N,crop) = 0. + DRATE (N,crop) = 0. + FRATE (N,crop) = 0. + END DO + endif + + END DO TILE_LOOP + + ! Update SPRINKLERRATE, DRIPRATE, FLOODRATE EXPORTS to be sent to land models. + ! FLOODRATE is weighted averaged over irrigated crops + paddy fractions. + + call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) + + END SUBROUTINE irrigrate_lai_trigger + + ! ---------------------------------------------------------------------------- + + SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & + SPRINKLERFR, DRIPFR, FLOODFR, & + CROPIRRIGFRAC,IRRIGPLANT, IRRIGHARVEST, IRRIGTYPE , & + SMWP,SMSAT,SMREF,SMCNT, RZDEF, & + SPRINKLERRATE, DRIPRATE, FLOODRATE, SRATE, DRATE, FRATE) + + implicit none + class(irrigation_model),intent(inout):: this + integer, intent (in) :: dofyr + real, dimension (:), intent (in) :: local_hour, SPRINKLERFR, DRIPFR, FLOODFR + real, dimension (:), intent (in) :: SMWP, SMSAT, SMREF, SMCNT, RZDEF + real, dimension(:,:), intent (in) :: CROPIRRIGFRAC ! NUM_CROPS + real, dimension(:,:), intent (in) :: IRRIGTYPE ! NUM_CROPS + real, dimension(:,:,:),intent (in) :: IRRIGPLANT ! NUM_SEASONS, NUM_CROPS + real, dimension(:,:,:),intent (in) :: IRRIGHARVEST ! NUM_SEASONS, NUM_CROPS + real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE + INTEGER :: NTILES, N, crop, sea, ITYPE, I + REAL :: ma, H1, H2, HC, IT, ROOTFRAC, void_frac + logical :: season_end (NUM_CROPS) + NTILES = SIZE (local_hour) + + TILE_LOOP : DO N = 1, NTILES + HC = local_hour(n) + IF_IRR: if(SUM(CROPIRRIGFRAC(N,:)) > 0.) then + ! the tile is irrigated crop or paddy + season_end = .true. + CROP_LOOP: DO crop = 1, NUM_CROPS + CROP_IN_TILE: if(CROPIRRIGFRAC(N,crop) > 0.) then + ! crop is grown in this tile + TWO_SEASONS: do sea = 1, NUM_SEASONS + IS_CROP: IF(IRRIGPLANT(N, sea, crop) /= 998) THEN + ! crop is grown in sea + IS_SEASON: IF(IS_WITHIN_SEASON(dofyr,NINT(IRRIGPLANT(N, sea, crop)),NINT(IRRIGHARVEST(N, sea, crop)))) THEN + ! dofyr falls within the crop season + season_end(crop) = .false. + PADDY_OR_CROP: if (crop == 3) then + ! PADDY TILE + H1 = this%flood_stime + H2 = this%flood_stime + this%flood_dur + if ((HC >= H1).AND.(HC < H2)) then + ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate. + if(H1 == HC) FRATE (N,crop) = RZDEF(N) /(H2 - H1)/ 3600. + else + FRATE (N,crop) = 0. + endif + SRATE (N,crop) = 0. + DRATE (N,crop) = 0. + + else + + ! IRRIGATED CROP: compute sum of irrigrates from 25 crops. + + ROOTFRAC = CROP_SEASON_STAGE (this%MIDS_LENGTH, dofyr,NINT(IRRIGPLANT(N, sea, crop)),NINT(IRRIGHARVEST(N, sea, crop))) + if(SMREF(N) > SMWP(N))then + ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) + else + ma = -1. + endif + + SOILM: if(ma >= 0) then + + ITYPE = NINT(IRRIGTYPE(N,crop)) + + CROP_IMETHOD: if (ITYPE == 0) then + + ! concurrently on sprinkler, drip and flood fractions + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + SRATE = SRATE (N,crop), & + DRATE = DRATE (N,crop), & + FRATE = FRATE (N,crop)) + + SRATE (N,crop) = SRATE (N,crop)*SPRINKLERFR(N) + DRATE (N,crop) = DRATE (N,crop)*DRIPFR (N) + FRATE (N,crop) = FRATE (N,crop)*FLOODFR (N) + + elseif (ITYPE > 0) then + + ! only this method + if (ITYPE == 1) call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), SRATE = SRATE (N,crop)) + if (ITYPE == 2) call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), DRATE = DRATE (N,crop)) + if (ITYPE == 3) call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), FRATE = FRATE (N,crop)) + + elseif (ITYPE < 0) then + + ! crop does not use IRRIG_METHOD -(ITYPE) + void_frac = 0. + DO I = 1,3 + if(I == ABS(ITYPE))then + ! this itype isn't used by this crop other 2 fractions equally share this fraction + if (I == 1) then + void_frac = SPRINKLERFR(N)/2. + SRATE(N,crop) = 0. + endif + if (I == 2) then + void_frac = DRIPFR (N)/2. + DRATE(N,crop) = 0. + endif + if (I == 3)then + void_frac = FLOODFR (N)/2. + FRATE(N,crop) = 0. + endif + else + if (I == 1) call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), SRATE = SRATE (N,crop)) + if (I == 2) call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), DRATE = DRATE (N,crop)) + if (I == 3) call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), FRATE = FRATE (N,crop)) + endif + END DO + DO I = 1,3 + if(I /= ABS(ITYPE))then + if (I == 1) SRATE (N,crop) = SRATE (N,crop)*(SPRINKLERFR(N) + void_frac) + if (I == 2) DRATE (N,crop) = DRATE (N,crop)*(DRIPFR (N) + void_frac) + if (I == 3) FRATE (N,crop) = FRATE (N,crop)*(FLOODFR (N) + void_frac) + endif + ENDDO + + endif CROP_IMETHOD + endif SOILM + ENDIF PADDY_OR_CROP + ENDIF IS_SEASON + end IF IS_CROP + end do TWO_SEASONS + endif CROP_IN_TILE + END DO CROP_LOOP + + ! turn off irrigation for crops that ended the season + DO crop = 1, NUM_CROPS + if(season_end(crop)) then + SRATE (N,crop) = 0. + DRATE (N,crop) = 0. + FRATE (N,crop) = 0. + endif + END DO + + endif IF_IRR + END DO TILE_LOOP + + ! Update SPRINKLERRATE, DRIPRATE, FLOODRATE EXPORTS to be sent to land models + ! They are weighted averaged over 26 crop fractions. + + call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + CROPIRRIGFRAC,SRATE,DRATE,FRATE) + + END SUBROUTINE irrigrate_crop_calendar + + ! ---------------------------------------------------------------------------- + + SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, & + IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) + + implicit none + + class(irrigation_model),intent(inout):: this + real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC + real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE + real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + integer :: N, NT + + ! INITIALIZE EXPORTS + SPRINKLERRATE = 0. + DRIPRATE = 0. + FLOODRATE = 0. + + NT = size (IRRIGFRAC) + + !_ASSERT(size (SRATE,2)==NUM_CROPS,'Irrigation model LAI trigger irrig tile types mismatch') + + DO N = 1, NT + IF ((IRRIGFRAC(N) + PADDYFRAC(N)) > 0.) THEN + SPRINKLERRATE (N) = SRATE (N,1) + DRIPRATE (N) = DRATE (N,1) + FLOODRATE (N) = (IRRIGFRAC(N)* FRATE (N,1) + PADDYFRAC(N)*FRATE (N,2)) & + /(IRRIGFRAC(N) + PADDYFRAC(N)) + ENDIF + END DO + + END SUBROUTINE update_irates_lai + + !............................................................................... + + SUBROUTINE update_irates_ccalendar(this,SPRINKLERRATE,DRIPRATE,FLOODRATE, & + CROPIRRIGFRAC,SRATE,DRATE,FRATE) + + implicit none + class(irrigation_model),intent(inout):: this + real, dimension(:,:), intent (in) :: CROPIRRIGFRAC ! NUM_CROPS + real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE + real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + integer :: N, NT, crop + + ! INITIALIZE EXPORTS + SPRINKLERRATE = 0. + DRIPRATE = 0. + FLOODRATE = 0. + + !_ASSERT(size (SRATE,2)==NUM_CROPS,'Irrigation model crop calandar trigger NUM_CROPS mismatch') + + NT = size (SPRINKLERRATE) + DO N = 1, NT + if(SUM(CROPIRRIGFRAC(N,:)) > 0.) then + DO crop = 1, NUM_CROPS + SPRINKLERRATE(N) = SPRINKLERRATE(N) + SRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + DRIPRATE(N) = DRIPRATE(N) + DRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + FLOODRATE(N) = FLOODRATE(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + END DO + endif + END DO + + END SUBROUTINE update_irates_ccalendar + + ! ---------------------------------------------------------------------------- + + SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, FRATE) + + implicit none + class (irrigation_model), intent(inout) :: this + REAL, intent (in) :: HC, ma, ROOTFRAC,SMCNT, SMREF + REAL, optional, intent (inout) :: SRATE, DRATE, FRATE + REAL :: H1, H2, IT + + if(present (SRATE)) then + ! SPRINKLER IRRIGATION + H1 = this%sprinkler_stime + H2 = this%sprinkler_stime + this%sprinkler_dur + IT = this%sprinkler_thres + if ((HC >= H1).AND.(HC < H2)) then + ! The model uses rootzone soil moisture state at H1 to compute irrigation + ! rates for the day and maintains the same rate through out the irrigation + ! duration (H1 <= HC < H2). + if((ma <= IT).AND.(H1 == HC)) & + SRATE = this%cwd (ROOTFRAC,SMCNT,SMREF,this%efcor)/(H2 - H1)/3600. + else + SRATE = 0. + endif + endif + + if(present (DRATE)) then + ! DRIP IRRIGATION + H1 = this%drip_stime + H2 = this%drip_stime + this%drip_dur + IT = this%sprinkler_thres + if ((HC >= H1).AND.(HC < H2)) then + ! use SMCNT at H1 during H1 <= HC < H2 to compute irrigrate. + ! Notice drip uses the same soil moisture threshold of sprinkler but with 0.% efficiency correction. + if((ma <= IT).AND.(H1 == HC)) & + DRATE = this%cwd(ROOTFRAC,SMCNT,SMREF,0.)/(H2 - H1)/3600. + else + DRATE = 0. + endif + endif + + if(present (FRATE)) then + ! FLOOD IRRIGATION + H1 = this%flood_stime + H2 = this%flood_stime + this%flood_dur + IT = this%flood_thres + if ((HC >= H1).AND.(HC < H2)) then + ! use SMCNT at H1 during H1 <= HC < H2 to compute irrigrate. + if((ma <= IT).AND.(H1 == HC)) & + FRATE = this%cwd (ROOTFRAC,SMCNT,SMREF,this%efcor)/(H2 - H1)/3600. + else + FRATE = 0. + endif + endif + + END SUBROUTINE irrig_by_method + + ! ---------------------------------------------------------------------------- + + REAL FUNCTION crop_water_deficit (this, rootfrac, asmc, smcref, efcor) + + implicit none + class(irrigation_model),intent(inout):: this + real, intent (in) :: rootfrac, asmc, smcref, efcor + + crop_water_deficit = 0. + if(smcref > asmc) crop_water_deficit = rootfrac*(smcref - asmc)*100.0/(100.0-efcor) + + END FUNCTION crop_water_deficit + + ! ---------------------------------------------------------------------------- + + logical FUNCTION IS_WITHIN_SEASON (DOY,DP, DH) + + implicit none + integer, intent (in) :: DOY,DP, DH + + IS_WITHIN_SEASON = .false. + if(DH > DP) then + if((DOY >= DP).AND.(DOY <= DH)) IS_WITHIN_SEASON = .true. + elseif (DH < DP) then + if((DOY >= DP).AND.(DOY <= 366)) IS_WITHIN_SEASON = .true. + if((DOY >= 1).AND.(DOY <= DH)) IS_WITHIN_SEASON = .true. + endif + + end FUNCTION IS_WITHIN_SEASON + + ! ---------------------------------------------------------------------------- + + real FUNCTION CROP_SEASON_STAGE (MSL, DOY,DP, DH) + + ! MSL : mid season length [-] as a fraction of the length of the season + ! DOY : doy of year + ! DP : plant date + ! DH : harvest date + ! MSL + ! 1.0 ___________________________ + ! /| |\ + ! / | | \ + ! / | | \ + ! / | | \ + ! --------------------- DOY ----------------------------> + ! t0 t1 t2 t3 + ! DP DH + ! |<---- SEAL -->| + + implicit none + real, intent (in) :: MSL + integer, intent (in) :: DOY,DP, DH + real :: seal, t0, t1, t2, t3, CTime + + CROP_SEASON_STAGE = 0. + + if(DH > DP) then + seal = real (DH - DP + 1) + CTime = real (DOY) + else + ! the crop season is fall-to-spring + seal = real(366 - DP + 1 + DH) + if((DOY >= DP).AND.(DOY <= 366)) CTIME = real (DOY) + if((DOY >= 1).AND.(DOY <= DH)) CTIME = real (DOY) + 365. + endif + + t0 = real (DP) + t1 = t0 + seal * (1. - MSL)/2. ! assumes equal development and late periods + t2 = t1 + seal*MSL + t3 = t0 + seal + + if (ctime < t1) CROP_SEASON_STAGE = (CTIME -t0)/(t1 - t0) + if ((t1 <= ctime).and.(ctime < t2)) CROP_SEASON_STAGE = 1. + if (ctime >= t2) CROP_SEASON_STAGE = (t3 - ctime)/(t3 - t2) + + if(CROP_SEASON_STAGE > 1.) CROP_SEASON_STAGE = 1. + + end FUNCTION CROP_SEASON_STAGE + +END MODULE IRRIGATION_MODULE diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index aab31393d..f6564236d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -2729,239 +2729,8 @@ subroutine dampen_tc_oscillations( dtstep, tair, tc_old, tc_new_in, & end subroutine dampen_tc_oscillations - ! ******************************************************************** - - SUBROUTINE irrigation_rate (IRRIG_METHOD, & - NTILES, AGCM_HH, AGCM_MI, AGCM_S, lons, IRRIGFRAC, PADDYFRAC, & - CLMPT,CLMST, CLMPF, CLMSF, LAIMAX, LAIMIN, LAI, & - POROS, WPWET, VGWMAX, RZMC, IRRIGRATE) - - ! !DESCRIPTION: - ! - ! NOTE: This is an experimental feature under development. - ! - ! Calculate water requirement and apply the amount to precipitation. - ! - ! Irrigate when available root zone soil moisture falls below tunable - ! irrigation threshold parameter. - ! Below GRIPC irrigated data provide fractions of croplands and paddy croplands. - ! The irrigation model is applied on a tile if: - ! (1) the irrigated fraction of the tile is greater than 0. AND - ! (2) primary or secondary type in the tile is CLM4 type 16 (cropland) AND - ! (3) LAI exceeds the LAI theshhold (60% of LAI range) - ! - ! GRIPC croplands and paddy croplands fractions determine whether to apply - ! either sprinkler or flood OR both irrigation methods. Each method has - ! its own local start times, durations and irrigation threshold parameters. - ! - ! We assume plants need available soil moisture stay above 1/3 of soil moisture range - ! [ wilting - saturation] - ! Irrigation amount is scaled to grid total crop fraction when intensity - ! is less than the fraction. Irrigation is expanded to non-crop, non-forest, - ! non-baresoil/urban tiles if intensity exceeds grid total crop fraction. - ! In latter case, scaled irrigation is applied to grassland first, - ! then further applied over the rest of tiles equally if the intensity - ! exceeds grassland fraction as well. - ! - ! Optionally efficiency correction is applied to account for field loss. - ! - ! REVISION HISTORY: - ! - ! Aug 2018: Sarith Mahanama ; Version 1 adapted from LIS subroutine clsmf25_getirrigationstates.F90 - - implicit none - - ! INPUTS - ! ------ - integer, intent (in) :: IRRIG_METHOD, NTILES, AGCM_HH, AGCM_MI, AGCM_S - real , intent (in), dimension (ntiles) :: lons, IRRIGFRAC, PADDYFRAC, LAIMAX, & - LAIMIN, LAI, CLMPT,CLMST, CLMPF, CLMSF, POROS, WPWET, VGWMAX, RZMC - ! IRRIG_METHOD : 0 sprinkler and flood combined; 1 sprinkler irrigation ; 2 flood irrigation - ! AGCM_HH / AGCM_MI / AGCM_S/ lons : Current hour, minute, second (UTC) and longitude - - ! Irrigation hotspots : Using the Global Rain-Fed, Irrigated, and Paddy Croplands (GRIPC) Dataset (Salmon et al., 2015) - ! Salmon JM, Friedl MA, Frolking S, Wisser D and Douglas EM: Global rain-fed, irrigated, - ! and paddy croplands: A new high resolution map derived from remote sensing, crop - ! inventories and climate data, Int. J. Appl. Earth Obs. Geoinf, 38, 321–334, - ! doi:10.1016/j.jag.2015.01.014, 2015. - - ! IRRIGFRAC : Fraction of irrigated croplands [-] = total number of 500m irrigated croplands pixels in the tile / - ! total number of 500m pixels in the tile - ! PADDYFRAC : Fraction of paddy croplands [-] = total number of 500m paddy croplands pixels in the tile / - ! total number of 500m pixels in the tile - ! LAIMAX / LAIMIN / LAI : Maximum, minimum and current Leaf Area Index - ! CLMPT / CLMST : CLM4 primary and secondary types (Note type 16 is cropland) - ! CLMPF / CLMSF : CLM4 fractions of primary and secondary types - ! POROS / WPWET / VGWMAX / RZMC : porosity [m3/m3], wilting point wetness [-], maximum and current root zone soil moisture content [m3/m3] - - ! ONLY output - ! ----------- - real , intent (out), dimension (ntiles) :: IRRIGRATE - - real, parameter :: efcor = 76.0 ! Efficiency Correction (%) - - ! Sprinkler parameters - ! -------------------- - real, parameter :: otimess = 6.0 ! local trigger check start time [hour] - real, parameter :: irrhrs = 4.0 ! duration of irrigation hours - real, parameter :: sprinkler_thersh = 0.5 ! soil moisture threshhold to trigger sprinkler irrigation - - ! Drip parameters (not currently implemented) - ! ------------------------------------------- - real, parameter :: otimeds = 6.0 ! local trigger check start time [hour] - real, parameter :: irrhrd = 12.0 ! duration of irrigation hours - - ! Flood parameters - ! ---------------- - real, parameter :: otimefs = 6.0 ! local trigger check start time [hour] - real, parameter :: irrhrf = 1.0 ! duration of irrigation hours - real, parameter :: flood_thersh = 0.25 ! soil moisture threshhold to trigger flood irrigation - - ! local vars - ! ---------- - real :: smcwlt, smcref, smcmax, asmc, laithresh, laifac, RZDEP, vfrac, ma, & - otimee, irrig_thresh, IrrigScale, s_irate, f_irate, local_long, local_hour - integer :: n, t, vtyp - - IRRIGRATE (:) = 0. - - TILE_LOOP : DO N = 1, NTILES - - local_long = 180. * lons(n) / PIE ! local logitude [degrees] - local_hour = AGCM_HH + AGCM_MI / 60. + AGCM_S / 3600. + 12.* local_long /180. ! local time [hours] - if (local_hour >= 24.) local_hour = local_hour - 24. - if (local_hour < 0.) local_hour = local_hour + 24. - - laithresh = laimin (n) + 0.60 * (laimax (n) - laimin (n)) - if(laimax (n) /= laimin (n)) then - laifac = (lai(n) - laimin (n)) / (laimax(n) - laimin(n)) - else - laifac = 0. - endif - - RZDEP = laifac * VGWMAX (n) / poros (n) ! root zone depth [mm] - smcwlt = RZDEP * wpwet (n) * poros (n) ! RZ soil moisture content at wilting point [mm] - smcref = RZDEP * (wpwet (n) + 0.333 * (1. - wpwet (n))) * poros(n) ! RZ reference soil moisture content [mm] - smcmax = RZDEP * poros (n) ! RZ soil moisture at saturatopm [mm] - asmc = RZDEP * rzmc (n) ! actual RZ soil moisture content [mm] - - CHECK_IRRIG_INTENSITY : IF ((IRRIGFRAC(N) + PADDYFRAC(N)) > 0.) THEN - - s_irate = 0. - f_irate = 0. - - TWO_CLMTYPS : DO t = 1, 2 - - if (t == 1) then - ! Primary CLM fraction - vtyp = NINT (CLMPT (n)) - vfrac = CLMPF (n) - endif - - if (t == 2) then - ! Secondary CLM fraction - vtyp = NINT (CLMST (n)) - vfrac = CLMSF (n) - endif - - CHECK_CROP_LAITHRESH : IF ((vtyp == 16).and.(vfrac > 0.).and.(lai(n) >= laithresh).and.(laifac > 0.)) THEN - - !----------------------------------------------------------------------------- - ! Compute irrigation scale parameter : - ! Scale the irrigation intensity to the crop % when intensity < crop%. - ! Expand irrigation for non-crop, non-forest when intensity > crop % - ! in preference order of grassland first then rest. - !----------------------------------------------------------------------------- - - IF ((IRRIGFRAC(N) + PADDYFRAC(N)) < vfrac) THEN - IrrigScale = vfrac / (IRRIGFRAC(N) + PADDYFRAC(N)) - ELSE - IrrigScale = 1. - ENDIF - - !----------------------------------------------------------------------------- - ! Get the root zone moisture availability to the plant - !----------------------------------------------------------------------------- - - if(smcref.ge.smcwlt) then - ma = (asmc - smcwlt) /(smcref - smcwlt) - else - ma = -1 - endif - - SELECT CASE (IRRIG_METHOD) - - !-------------------------------------------------------------------------------------------------------------------------- - ! IRRIGRATE : irrigation rate required to fill up water deficit before END OF IRRIGATION PERIOD (otimee - local_hour) - !-------------------------------------------------------------------------------------------------------------------------- - - CASE (0) - ! SPRINKLER AND FLOOD IRRIGATION COMBINED - ! --------------------------------------- - C_SPRINKLER : IF((IRRIGFRAC (N) > 0.).and.(local_hour >= otimess).and. (local_hour < otimess + irrhrs)) THEN - otimee = otimess + irrhrs ; irrig_thresh = sprinkler_thersh - IF ((ma <= irrig_thresh).and.(ma.ge.0)) THEN - s_irate = crop_water_deficit (IRRIGFRAC (N) * irrigScale, asmc, smcref, efcor) / (otimee - local_hour) /3600.0 - ENDIF - ENDIF C_SPRINKLER - - C_FLOOD : IF((PADDYFRAC (N) > 0.).and.(local_hour >= otimefs).and. (local_hour <= otimefs + irrhrf)) THEN - otimee = otimefs + irrhrf ; irrig_thresh = flood_thersh - IF ((ma <= irrig_thresh).and.(ma.ge.0)) THEN - f_irate = crop_water_deficit (PADDYFRAC (N) * irrigScale, asmc, smcref, efcor) / (otimee - local_hour) /3600.0 - ENDIF - ENDIF C_FLOOD - - IRRIGRATE (N) = (s_irate * IRRIGFRAC (N) + f_irate * PADDYFRAC (N)) / (IRRIGFRAC(N) + PADDYFRAC(N)) ! weighted averaged sprinkler + flood - - CASE (1) - ! SPRINKLER IRRIGATION ONLY - ! ------------------------- - SPRINKLER : IF(((IRRIGFRAC (N) + PADDYFRAC (N)) > 0.).and.(local_hour >= otimess).and. (local_hour < otimess + irrhrs)) THEN - otimee = otimess + irrhrs ; irrig_thresh = sprinkler_thersh - IF ((ma <= irrig_thresh).and.(ma.ge.0)) THEN - IRRIGRATE (N) = crop_water_deficit ((IRRIGFRAC (N) + PADDYFRAC (N)) * irrigScale, asmc, smcref, efcor) / & - (otimee - local_hour) /3600.0 - ENDIF - ENDIF SPRINKLER - - CASE (2) - ! FLOOD IRRIGATION ONLY - ! --------------------- - FLOOD : IF(((IRRIGFRAC (N) + PADDYFRAC (N)) > 0.).and.(local_hour >= otimefs).and. (local_hour <= otimefs + irrhrf)) THEN - otimee = otimefs + irrhrf ; irrig_thresh = flood_thersh - IF ((ma <= irrig_thresh).and.(ma.ge.0)) THEN - IRRIGRATE (N) = crop_water_deficit ((IRRIGFRAC (N) +PADDYFRAC (N)) * irrigScale, asmc, smcref, efcor) / & - (otimee - local_hour) /3600.0 - ENDIF - ENDIF FLOOD - - CASE DEFAULT - print *, 'IN IRRIGATION_RATE : IRRIGATION_METHOD can be 0, 1, or 2' - call exit(1) - END SELECT - END IF CHECK_CROP_LAITHRESH - END DO TWO_CLMTYPS - END IF CHECK_IRRIG_INTENSITY - END DO TILE_LOOP - - END SUBROUTINE irrigation_rate - - ! ******************************************************************** - - REAL FUNCTION crop_water_deficit (IrrigScale, asmc, smcref, efcor) - - implicit none - - real, intent (in) :: IrrigScale, asmc, smcref, efcor - real :: twater - - twater = smcref - asmc - twater = twater * IrrigScale ! Scale the irrigation intensity - crop_water_deficit = twater*(100.0/(100.0-efcor)) ! Apply efficiency correction - - END FUNCTION crop_water_deficit + ! ******************************************************************* + - ! ******************************************************************** END MODULE lsm_routines diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc index 27c94126d..b53bbaeda 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc @@ -159,21 +159,51 @@ #--------------------------------------------------------# # ---- Run irrigation module -# + +# NOTE: The irrigation model needs the irrigation parameter file ('irrigation_IMxJM_DL.dat') in BCSDIR to run the model. # 0 : Do NOT run irrigation module (default) -# 1 : YES, run irrigation module +# 1 : YES, run irrigation module - +# # # GEOSagcm=>RUN_IRRIG: 0 -# GEOSldas=>RUN_IRRIG: 0 - -# ---- Irrigation model method +# GEOSldas=>RUN_IRRIG: 1 +# # -# 0 : Sprinkler and Flood irrigation combined (default) -# 1 : Sprinkler irrigation only -# 2 : Flood irrigation only +# ---- Irrigation trigger +# +# 0 : (Default) LAI-based trigger turns irrigation on if LAI >= (LAImin + LAI_THRES * (LAImax - LAImin)) +# 1 : Use planting and harvesting times from 26 crop calendars +# +# GEOSagcm=>IRRIG_TRIGGER: 0 +# GEOSldas=>IRRIG_TRIGGER: 0 +# +# ---- Irrigation method (ONLY available with IRRIG_TRIGGER: 0) +# +# While the crop calendar based trigger uses crop-specific irrigation methods, the LAI-based trigger (IRRIG_TRIGGER: 0) offers below +# 4 different irrigation methods to choose from: +# 0 : CONCURRENTLY Sprinkler, Flood, and DRIP irrigation methods on method specific tile fractions (default) +# 1 : Sprinkler irrigation on entire tile +# 2 : Drip irrigation on entire tile +# 3 : Flood irrigation on entire tile # # GEOSagcm=>IRRIG_METHOD: 0 # GEOSldas=>IRRIG_METHOD: 0 +# +# ----- Below default parameter values can also be changed via this resource file: +# +# IRRIG_THRES: 0.5 # threshold of tile fraction to turn the irrigation model on. +# LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on +# SPRINKLER_STIME: 6.0 # sprinkler irrigatrion start time [hours] +# SPRINKLER_DUR: 4.0 # sprinkler irrigation duration [hours] +# SPRINKLER_THRES: 0.7 # soil moisture threshhold to trigger sprinkler irrigation +# DRIP_STIME: 8.0 # drip irrigatrion start time [hours] +# DRIP_DUR: 8.0 # drip irrigation duration [hours] +# FLOOD_STIME: 6.0 # flood irrigatrion start time [hours] +# FLOOD_DUR: 1.0 # flood irrigation duration [hours] +# FLOOD_THRES: 0.6 # soil moisture threshhold to trigger flood irrigation +# IRR_EFCOR: 30.0 # Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use ) +# MIDS_LENGTH: 0.6 # Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER : 1) +# # lengths of development and end seasons are assumed as (1 - MIDS_LENGTH) / 2. #--------------------------------------------------------# From fc5dec29edca2fe67e81819b480794f90c71fe81 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Tue, 13 Feb 2024 16:15:43 -0800 Subject: [PATCH 02/55] removed irrigation_rate from lsm_routines --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index f6564236d..603ff013a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -56,7 +56,7 @@ MODULE lsm_routines PUBLIC :: SIBALB, catch_calc_soil_moist, catch_calc_zbar, catch_calc_peatclsm_waterlevel PUBLIC :: catch_calc_subtile2tile PUBLIC :: gndtmp, catch_calc_tp, catch_calc_wtotl, catch_calc_ght, catch_calc_FT - PUBLIC :: dampen_tc_oscillations, irrigation_rate + PUBLIC :: dampen_tc_oscillations INTERFACE catch_calc_zbar MODULE PROCEDURE catch_calc_zbar_scalar From a1ad6d759d8940e9d6172a799fc14b4425aa052f Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Tue, 13 Feb 2024 20:29:01 -0800 Subject: [PATCH 03/55] fixed typos --- .../GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 1d06aa865..1a65bc4e5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5536,7 +5536,7 @@ subroutine Driver ( RC ) if (ntiles >0) then call CATCHMENT ( NTILES, LONS, LATS ,& - DT,CATCH_INTERNAL_SuATE%USE_FWET_FOR_RUNOFF ,& + DT,CATCH_INTERNAL_STATE%USE_FWET_FOR_RUNOFF ,& CATCH_INTERNAL_STATE%FWETC, CATCH_INTERNAL_STATE%FWETL,& cat_id, VEG, DZSF ,& PCU , PLS_IN , SNO, ICE, FRZR ,& From 4cd4fc0b344fffbfe9b78abda79869401edff3a4 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 14 Feb 2024 15:19:18 -0800 Subject: [PATCH 04/55] integration changes from feature/SM_irrigation_model Part 2 (GEOS_catchCN_GridComp folder) --- .../GEOS_CatchCNGridComp.F90 | 29 +++ .../GEOS_CatchCNCLM40GridComp.F90 | 223 ++++++------------ .../GEOS_CatchCNCLM45GridComp.F90 | 222 ++++++----------- .../.GEOS_CatchGridComp.F90.swp | Bin 0 -> 16384 bytes 4 files changed, 166 insertions(+), 308 deletions(-) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/.GEOS_CatchGridComp.F90.swp diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 4e1e0bc26..9ad45a38f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -671,6 +671,33 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'SPRINKLERRATE' ,& + LONG_NAME = 'sprinkler_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'DRIPRATE' ,& + LONG_NAME = 'drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'FLOODRATE' ,& + LONG_NAME = 'flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + ! EXPORT STATE: call MAPL_AddExportSpec ( GC, SHORT_NAME = 'LST', CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) @@ -790,6 +817,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'PRLAND' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRLAND' , CHILD_ID = CATCHCN, RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SNOLAND' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRPARLAND' , CHILD_ID = CATCHCN, RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index c05e39388..c0bc12043 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -66,7 +66,7 @@ module GEOS_CatchCNCLM40GridCompMod use clm_time_manager, only: get_days_per_year, get_step_size use pftvarcon, only: noveg USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & - catch_calc_zbar, catch_calc_peatclsm_waterlevel, irrigation_rate, & + catch_calc_zbar, catch_calc_peatclsm_waterlevel, & gndtmp use catch_wrap_stateMod @@ -770,6 +770,33 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'SPRINKLERRATE' ,& + LONG_NAME = 'sprinkler_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'DRIPRATE' ,& + LONG_NAME = 'drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'FLOODRATE' ,& + LONG_NAME = 'flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + ! !INTERNAL STATE: ! if is_offline, some variables ( in the last) are not required @@ -2033,117 +2060,11 @@ subroutine SetServices ( GC, RC ) endif -! IRRIGATION MODEL INTERNAL - - IF (RUN_IRRIG /= 0) THEN - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'fraction_of_irrigated_cropland',& - UNITS = '1' ,& - SHORT_NAME = 'IRRIGFRAC' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'fraction_of_paddy_cropland',& - UNITS = '1' ,& - SHORT_NAME = 'PADDYFRAC' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'Maximum_LAI' ,& - UNITS = '1' ,& - SHORT_NAME = 'LAIMAX' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'Minimum_LAI' ,& - UNITS = '1' ,& - SHORT_NAME = 'LAIMIN' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_primary_type' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMPT' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_secondary_type' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMST' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_primary_fraction' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMPF' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_secondary_fraction' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMSF' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - ENDIF - - !EOS ! EXPORT STATE: - IF (RUN_IRRIG /= 0) THEN - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'irrigation_rate' ,& - UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'IRRIGRATE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - ENDIF - + call MAPL_AddExportSpec(GC, & LONG_NAME = 'evaporation' ,& UNITS = 'kg m-2 s-1' ,& @@ -2948,6 +2869,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'IRRLAND', & + LONG_NAME = 'Total_irrigation_land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SNOLAND', & LONG_NAME = 'snowfall_land', & @@ -4588,7 +4518,9 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: GRN real, dimension(:), pointer :: ASCATZ0 real, dimension(:), pointer :: NDVI - + real, dimension(:), pointer :: SPRINKLERRATE + real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FLOODRATE real, dimension(:,:), pointer :: DUDP real, dimension(:,:), pointer :: DUSV real, dimension(:,:), pointer :: DUWT @@ -4705,15 +4637,7 @@ subroutine Driver ( RC ) real, dimension(:,:), pointer :: RBC002 real, dimension(:,:), pointer :: ROC001 real, dimension(:,:), pointer :: ROC002 - real, dimension(:), pointer :: IRRIGFRAC - real, dimension(:), pointer :: PADDYFRAC - real, dimension(:), pointer :: LAIMAX - real, dimension(:), pointer :: LAIMIN - real, dimension(:), pointer :: CLMPT - real, dimension(:), pointer :: CLMST - real, dimension(:), pointer :: CLMPF - real, dimension(:), pointer :: CLMSF - + ! ----------------------------------------------------- ! EXPORT Pointers ! ----------------------------------------------------- @@ -4782,6 +4706,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND + real, dimension(:), pointer :: IRRLAND real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -4871,7 +4796,6 @@ subroutine Driver ( RC ) real, pointer, dimension(:) :: RMELTBC002 real, pointer, dimension(:) :: RMELTOC001 real, pointer, dimension(:) :: RMELTOC002 - real, pointer, dimension(:) :: IRRIGRATE real, pointer, dimension(:) :: PEATCLSM_WATERLEVEL real, pointer, dimension(:) :: PEATCLSM_FSWCHANGE @@ -4911,7 +4835,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: fveg1, fveg2 real,pointer,dimension(:) :: FICE1TMP real,pointer,dimension(:) :: SLDTOT - + real,pointer,dimension(:) :: PLS_IN ! real*8,pointer,dimension(:) :: fsum real,pointer,dimension(:,:) :: ghtcnt @@ -5017,7 +4941,6 @@ subroutine Driver ( RC ) ! unadulterated TC's and QC's real, pointer :: TC1_0(:), TC2_0(:), TC4_0(:) real, pointer :: QA1_0(:), QA2_0(:), QA4_0(:) - real, pointer :: PLSIN(:) ! CATCHMENT_SPINUP integer :: CurrMonth, CurrDay, CurrHour, CurrMin, CurrSec @@ -5252,6 +5175,9 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSSV ,'SSSV' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSWT ,'SSWT' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRIPRATE,'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FLOODRATE,'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- ! INTERNAL Pointers @@ -5351,17 +5277,6 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,ROC002 ,'ROC002' , RC=STATUS); VERIFY_(STATUS) endif - IF (catchcn_internal%RUN_IRRIG /= 0) THEN - call MAPL_GetPointer(INTERNAL,IRRIGFRAC ,'IRRIGFRAC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,PADDYFRAC ,'PADDYFRAC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,LAIMAX ,'LAIMAX' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,LAIMIN ,'LAIMIN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMPT ,'CLMPT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMST ,'CLMST' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMPF ,'CLMPF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMSF ,'CLMSF' , RC=STATUS); VERIFY_(STATUS) - ENDIF - ! ----------------------------------------------------- ! EXPORT POINTERS ! ----------------------------------------------------- @@ -5431,6 +5346,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP, 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND, 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND, 'PRLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IRRLAND,'IRRLAND', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND, 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND, 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND, 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -5515,8 +5431,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,RMELTOC002,'RMELTOC002', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PEATCLSM_WATERLEVEL,'PEATCLSM_WATERLEVEL',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PEATCLSM_FSWCHANGE ,'PEATCLSM_FSWCHANGE', RC=STATUS); VERIFY_(STATUS) - IF (catchcn_internal%RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) - + NTILES = size(PS) allocate( ityp(ntiles,nveg,nzone) ) @@ -5764,7 +5679,7 @@ subroutine Driver ( RC ) allocate(QA1_0 (NTILES)) allocate(QA2_0 (NTILES)) allocate(QA4_0 (NTILES)) - allocate(PLSIN (NTILES)) + allocate(PLS_IN (NTILES)) call ESMF_VMGetCurrent ( VM, RC=STATUS ) @@ -7032,28 +6947,23 @@ subroutine Driver ( RC ) ! gkw: end of main CN block - PLSIN = PLS + PLS_IN = PLS ! -------------------------------------------------------------------------- - ! Call Irrigation Model + ! Add irrigation model imports ! -------------------------------------------------------------------------- - IF ((catchcn_internal%RUN_IRRIG /= 0).AND.(ntiles >0)) THEN - - CALL CATCH_CALC_SOIL_MOIST ( & - NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & - srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) - - call irrigation_rate (catchcn_internal%IRRIG_METHOD, & - NTILES, AGCM_HH, AGCM_MI, sofmin, lons, IRRIGFRAC, PADDYFRAC, & - CLMPT,CLMST, CLMPF, CLMSF, LAIMAX, LAIMIN, LAI0, & - POROS, WPWET, VGWMAX, RZMC, IRRIGRATE) - - PLSIN = PLS + IRRIGRATE - + IF ((catchcn_internal%RUN_IRRIG /= 0)) THEN + where (SPRINKLERRATE > 0) + PLS_IN = PLS_IN + SPRINKLERRATE + end where + where (DRIPRATE > 0) + RZEXC = RZEXC + DRIPRATE*DT + end where + where (FLOODRATE > 0) + RZEXC = RZEXC + FLOODRATE*DT + end where ENDIF - #ifdef DBG_CNLSM_INPUTS call MAPL_Get(MAPL, LocStream=LOCSTREAM, RC=STATUS) VERIFY_(STATUS) @@ -7072,7 +6982,7 @@ subroutine Driver ( RC ) ! Inputs call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, PLS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PLS_IN, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) @@ -7240,7 +7150,7 @@ subroutine Driver ( RC ) call CATCHCN ( NTILES, LONS, LATS, DT,catchcn_internal%USE_FWET_FOR_RUNOFF, & catchcn_internal%FWETC, catchcn_internal%FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF ,& - PCU , PLSIN , SNO, ICE, FRZR ,& + PCU , PLS_IN , SNO, ICE, FRZR ,& UUU ,& EVSBT(:,FSAT), DEVSBT(:,FSAT), DEDTC(:,FSAT) ,& @@ -7473,6 +7383,9 @@ subroutine Driver ( RC ) if(associated( WCPR )) WCPR = PRMC if(associated( ACCUM)) ACCUM = SLDTOT - EVPICE*(1./MAPL_ALHS) - SMELT if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT + if(associated(IRRLAND)) then + if (catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE + endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(EVPSNO)) EVPSNO = EVPICE if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) @@ -7790,7 +7703,7 @@ subroutine Driver ( RC ) deallocate( ht ) deallocate( tp ) deallocate( soilice ) - deallocate (PLSIN) + deallocate (PLS_IN) call MAPL_TimerOff ( MAPL, "-CATCHCNCLM40" ) RETURN_(ESMF_SUCCESS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index ed3924a33..165e0e1fe 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -65,7 +65,7 @@ module GEOS_CatchCNCLM45GridCompMod use clm_time_manager, only: get_days_per_year, get_step_size use pftvarcon, only: noveg USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & - catch_calc_zbar, catch_calc_peatclsm_waterlevel, irrigation_rate, & + catch_calc_zbar, catch_calc_peatclsm_waterlevel, & gndtmp use update_model_para4cn, only : upd_curr_date_time @@ -772,6 +772,33 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'SPRINKLERRATE' ,& + LONG_NAME = 'sprinkler_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'DRIPRATE' ,& + LONG_NAME = 'drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'FLOODRATE' ,& + LONG_NAME = 'flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) ! !INTERNAL STATE: @@ -1976,117 +2003,11 @@ subroutine SetServices ( GC, RC ) endif -! IRRIGATION MODEL INTERNAL - - IF (RUN_IRRIG /= 0) THEN - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'fraction_of_irrigated_cropland',& - UNITS = '1' ,& - SHORT_NAME = 'IRRIGFRAC' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'fraction_of_paddy_cropland',& - UNITS = '1' ,& - SHORT_NAME = 'PADDYFRAC' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'Maximum_LAI' ,& - UNITS = '1' ,& - SHORT_NAME = 'LAIMAX' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'Minimum_LAI' ,& - UNITS = '1' ,& - SHORT_NAME = 'LAIMIN' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_primary_type' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMPT' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_secondary_type' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMST' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_primary_fraction' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMPF' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'CLM_secondary_fraction' ,& - UNITS = '1' ,& - SHORT_NAME = 'CLMSF' ,& - FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RESTART = MAPL_RestartRequired ,& - RC=STATUS ) - VERIFY_(STATUS) - - ENDIF - !EOS ! EXPORT STATE: - IF (RUN_IRRIG /= 0) THEN - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'irrigation_rate' ,& - UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'IRRIGRATE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - ENDIF - call MAPL_AddExportSpec(GC, & LONG_NAME = 'evaporation' ,& UNITS = 'kg m-2 s-1' ,& @@ -2883,6 +2804,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'IRRLAND', & + LONG_NAME = 'Total_irrigation_land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SNOLAND', & LONG_NAME = 'snowfall_land', & @@ -4553,6 +4483,10 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ASCATZ0 real, dimension(:), pointer :: NDVI + real, dimension(:), pointer :: SPRINKLERRATE + real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FLOODRATE + real, dimension(:,:), pointer :: DUDP real, dimension(:,:), pointer :: DUSV real, dimension(:,:), pointer :: DUWT @@ -4682,14 +4616,6 @@ subroutine Driver ( RC ) real, dimension(:,:), pointer :: RBC002 real, dimension(:,:), pointer :: ROC001 real, dimension(:,:), pointer :: ROC002 - real, dimension(:), pointer :: IRRIGFRAC - real, dimension(:), pointer :: PADDYFRAC - real, dimension(:), pointer :: LAIMAX - real, dimension(:), pointer :: LAIMIN - real, dimension(:), pointer :: CLMPT - real, dimension(:), pointer :: CLMST - real, dimension(:), pointer :: CLMPF - real, dimension(:), pointer :: CLMSF real, dimension(:), pointer :: T2M10D real, dimension(:), pointer :: TPREC10D real, dimension(:), pointer :: TPREC60D @@ -4762,6 +4688,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND + real, dimension(:), pointer :: IRRLAND real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -4854,7 +4781,6 @@ subroutine Driver ( RC ) real, pointer, dimension(:) :: RMELTBC002 real, pointer, dimension(:) :: RMELTOC001 real, pointer, dimension(:) :: RMELTOC002 - real, pointer, dimension(:) :: IRRIGRATE real, pointer, dimension(:) :: PEATCLSM_WATERLEVEL real, pointer, dimension(:) :: PEATCLSM_FSWCHANGE @@ -4894,7 +4820,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: fveg1, fveg2 real,pointer,dimension(:) :: FICE1TMP real,pointer,dimension(:) :: SLDTOT - + real,pointer,dimension(:) :: PLS_IN ! real*8,pointer,dimension(:) :: fsum real,pointer,dimension(:,:) :: ghtcnt @@ -4999,7 +4925,6 @@ subroutine Driver ( RC ) ! unadulterated TC's and QC's real, pointer :: TC1_0(:), TC2_0(:), TC4_0(:) real, pointer :: QA1_0(:), QA2_0(:), QA4_0(:) - real, pointer :: PLSIN(:) ! CATCHMENT_SPINUP integer :: CurrMonth, CurrDay, CurrHour, CurrMin, CurrSec @@ -5271,6 +5196,9 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSSV ,'SSSV' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSWT ,'SSWT' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRIPRATE, 'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FLOODRATE, 'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- ! INTERNAL Pointers @@ -5387,17 +5315,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,ROC002 ,'ROC002' , RC=STATUS); VERIFY_(STATUS) endif - IF (catchcn_internal%RUN_IRRIG /= 0) THEN - call MAPL_GetPointer(INTERNAL,IRRIGFRAC ,'IRRIGFRAC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,PADDYFRAC ,'PADDYFRAC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,LAIMAX ,'LAIMAX' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,LAIMIN ,'LAIMIN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMPT ,'CLMPT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMST ,'CLMST' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMPF ,'CLMPF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CLMSF ,'CLMSF' , RC=STATUS); VERIFY_(STATUS) - ENDIF - + ! ----------------------------------------------------- ! EXPORT POINTERS ! ----------------------------------------------------- @@ -5466,6 +5384,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP , 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND , 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND , 'PRLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IRRLAND , 'IRRLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND , 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND , 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND , 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -5553,9 +5472,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,RMELTOC002 ,'RMELTOC002' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PEATCLSM_WATERLEVEL,'PEATCLSM_WATERLEVEL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PEATCLSM_FSWCHANGE ,'PEATCLSM_FSWCHANGE' , RC=STATUS); VERIFY_(STATUS) - - IF (catchcn_internal%RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) - + NTILES = size(PS) allocate( ityp(ntiles,nveg,nzone) ) @@ -5793,7 +5710,7 @@ subroutine Driver ( RC ) allocate(QA1_0 (NTILES)) allocate(QA2_0 (NTILES)) allocate(QA4_0 (NTILES)) - allocate(PLSIN (NTILES)) + allocate(PLS_IN (NTILES)) call ESMF_VMGetCurrent ( VM, RC=STATUS ) @@ -7313,27 +7230,23 @@ subroutine Driver ( RC ) ! gkw: end of main CN block - PLSIN = PLS + PLS_IN = PLS ! -------------------------------------------------------------------------- - ! Call Irrigation Model + ! Add irrigation model imports ! -------------------------------------------------------------------------- - IF ((catchcn_internal%RUN_IRRIG /= 0).AND.(ntiles >0)) THEN - - CALL CATCH_CALC_SOIL_MOIST ( & - NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & - srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) - - call irrigation_rate (catchcn_internal%IRRIG_METHOD, & - NTILES, AGCM_HH, AGCM_MI, AGCM_S, lons, IRRIGFRAC, PADDYFRAC, & - CLMPT,CLMST, CLMPF, CLMSF, LAIMAX, LAIMIN, LAI0, & - POROS, WPWET, VGWMAX, RZMC, IRRIGRATE) - - PLSIN = PLS + IRRIGRATE - - ENDIF + IF (catchcn_internal%RUN_IRRIG /= 0) THEN + where (SPRINKLERRATE > 0) + PLS_IN = PLS_IN + SPRINKLERRATE + end where + where (DRIPRATE > 0) + RZEXC = RZEXC + DRIPRATE*DT + end where + where (FLOODRATE > 0) + RZEXC = RZEXC + FLOODRATE*DT + end where + ENDIF #ifdef DBG_CNLSM_INPUTS call MAPL_Get(MAPL, LocStream=LOCSTREAM, RC=STATUS) @@ -7353,7 +7266,7 @@ subroutine Driver ( RC ) ! Inputs call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, PLS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PLS_IN, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) @@ -7520,7 +7433,7 @@ subroutine Driver ( RC ) call CATCHCN ( NTILES, LONS, LATS, DT,catchcn_internal%USE_FWET_FOR_RUNOFF, & catchcn_internal%FWETC, catchcn_internal%FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF ,& - PCU , PLSIN , SNO, ICE, FRZR ,& + PCU , PLS_IN , SNO, ICE, FRZR ,& UUU ,& EVSBT(:,FSAT), DEVSBT(:,FSAT), DEDTC(:,FSAT) ,& @@ -7757,6 +7670,9 @@ subroutine Driver ( RC ) if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT + if(associated(IRRLAND)) then + if(catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE + endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(DRPARLAND)) DRPARLAND = DRPAR if(associated(DFPARLAND)) DFPARLAND = DFPAR @@ -8121,7 +8037,7 @@ subroutine Driver ( RC ) deallocate( ht ) deallocate( tp ) deallocate( soilice ) - deallocate (PLSIN) + deallocate (PLS_IN) call MAPL_TimerOff ( MAPL, "-CATCHCNCLM45" ) RETURN_(ESMF_SUCCESS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/.GEOS_CatchGridComp.F90.swp b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/.GEOS_CatchGridComp.F90.swp new file mode 100644 index 0000000000000000000000000000000000000000..05d2f5c727c3fc36a26368c9e02e3d9a633b314b GIT binary patch literal 16384 zcmeI2Yj7l06~|jZQ4mEIMJc6jSZbX>CYxlJb(2&qCo`R7*m;EMnJk-HX*x4^l3shJ zhwh$avnWt%SyWNt2dgM8sS>LAAXoi9eKWhL zNId{BFR_v!1($R|9|Zv|cn8s||D7vukO$(K2n%vlmgP+g!(Ffpws@ zENLyR`gYathLDAR+pAku9xZgNW-VG$wSwwWw8%`0vamgaQ=>zN{#G%KGw?>qz%kmE zkzqNWH=f+bHXK)Zqcl8jXPkjJ191l848$3TGZ1GW&On@jI0OHK3AU<|@=O(QGZ^UPbU!?Hoi5H1Kpzyyc@jr-X zG~x>5|3&d{EBwz2zg6MSDSX45qw)Ww@CAiGOFZnqs}=qX@iRMNwU-tCw8D41C0hSe z#KZhurtm*1{!c6X4+@_+G8+H)#KZA%iNb%U)c>%;pH$+X_SR_p-x3e|_u~qGLg9BP z{5Ql6%HN4^i^l&o@o;=L6#h8zIr6_*;lCmt_Rk4NMdLq4JbYrXr0_?HHz@w~3jZbX z-Na8lIvW2G;!Wb8QTW43{O1+^5OI_It+z+xKS+EZ@tYL>0P#J<$Bv2m-%s2nex<^H zq3{jwi2DDWc$oiBDttfjF#iuI{66C0`0sybH2%HB!~R)S_&vnWqW0gV@Vgbh>DXxe zpApx||9pktMSKhKTNM6N;-?aSLE(22PZDSE>fD6$+a1LFiRTsm6XK^4Usm|-#6L>> z3WfiexJCR`h2KW}4C3Z-otvx}Aev`sYh2Ka#Z2#vJegpAM6#ssOUr+oa#9vYPb;QSsPrSQx z6Sn{R#52VAD*SuIcM!i$;nxxm=bt0r6ODfj@$maq75-h~KE?l1>FPP4SgB91iBcShx(zHaF)0Yx)kEjR_Ji(UYudR0bLDU2o<4| zpl5J)x(>P+nuo@qQD{5#7|v~vLbpTLK;MME2we(Y1YHPS09By{s0bCH95fA0LB~Un z<9vBFbOCfeG!N~9#-XF22XVd?XW-9592$j=fcE3u{T1juXg4$teE@nt^eh(nXP_&g zBD4{D5ziU!gsy-tht7tMhD3ke7jBM}p6+AW>B(8P%oka(+TuQ2vX(hp;JnEiR;$Hp zEO41&FC_D>Z`oBc()!p`JDIcHHe0}Z5(j!!-Nu65?D(aZx(0~=_lrv`SmHismWMh# z*QyC`<~E(xeuUH;w(r}^cCgBpEvJpf)IGPscG}JY_ZSbD<*>x?=;-JGE2PS)WO+6z z{z{Gvjc(aC(ywVAx10gSSj+OP1`psgHpVhT=HxDOeomhTVQhj84Q|`k+jM@t>F^e< zuV>hNwqPQrIiqK%XUa0{&~WdtGqaO9S$F532{t@5G&I=T)<|Wy&d*IJ3gun1MnA$P zHj4%iZ99F-K#!Z@!Jz>b{=+tlEY9)8WR155(WlkG^%x>Dyxt;i>k!_naqQ+IbL-5L zJ>u}@Vz9&#O?QRyy{$xY@brF$WZKPuFLG}nl1$kwv?`yP&6$Nt9vMJGbwfkN>#pr% zjAe8~FO_@I4}ngmN;)%&*&G?r=&03f@lp@En>Pc`=04#B+CMzRR&2Bvrp)IS69Y)R ztHbOn@0W;-?WVMG_@Y%^WmUJv*$QWEzcV!DFyGF!zErL}CP20Ad8o}<6(({>vTZcl z6F$d~U2vB<@;mXLU%kHlHj$g1snQfHmvr4=iE^coDWyaQuDebbnJN`inVg=QV#Z9V zGHLX(+X}nsQW1ezx;Uqodf9A&O+nWYN(Pga_p%#_)S1!K*-WKaF*>d7ND`?}j zI1IY560J`!&T4&{)@m;}m{AQL7~EUN@WpwtkM+$~CUe;|%j@|`y~L&}g>*SvEEvdA z%d?jeO0yd+INAYgx=pSzhX2Hv?Yy71;#n=zN2Yn+t!aH5lgS9Sn^g~`mSW6ZY~EN5YWs=y3VHGS81%!X_GL8Q3F@kX48 zv4R$O4qxUDRvgy3X7yA#oip<0Y_U`{%<@c0H)e{tOvsH~aaJc=d`x_prQtAR8inFc zQ$jJjGqy>SAL#PJ&QxyFEM!ah)LE)Sr&M~V4s%(fheM|{>QI^~P8n1iKB7&MP-#-Z zoG!1~uQ`bFj%kN>n^cfruj|sSp;Nx*A{;~qbyAYXkSM1LWux0i-3Z~$rf%Miz~+mN z9qbc75mR=b<>M9+<%NmdG>ptF)>V0D%!PM5(Pk>k46Nl{7FD_qm99gj>rgRNhhjQ( zD5gV)Vmfp{nd&gvb(rirOm-bmraEN0P0Dnel<77JWf2Ec<}e%S6-vl~AKi}Xk;R}T z(zw<~((fP+!qUXAh}Ya64x(p`a#o+tWy|woybBxp^&QxnZVeih%3pm0D;EmHEFgzR zUN4l*d@-ZvUT1g+kBnz6rd?jIV@^RFU(6ewSmK3Svx2EqEn71Y8v(M`jrYcm*aO+v(2C_C+2B?a)3AKm zmz~?TngQl=?hmrE+)JQYm@rXo4GBSu)-uA-Xf&d;=jg00zT9}!cwNks(kmOtMp!IZ zag&{vdu{BZId;CaP91gI^8@-;?t;vLbj4N$ZfGL&TX+$fb;8!z!m6y&ZZ2`p7Hf#( zqPwv(LJVw58=Y^7o!k!B7rR}#MIK~{5$rGf2U!YD2DAfT03^%2flUQ*z8iH%l!uPhtX#Q{ZbqC)G;yl*rL+pQ3xm+=ACQ|*(t|u(tcdNG8 z51^nQxoD23CWgjAzU%ngX{>vc`nt>SfGHmukUxluME`vS|eF}1+ zCX|OntQ}B%#Tke*5N9CHK%9X%191l848$3TGZ1GW&cOd^25{I69}4w8k!!*N56$Ue zG%HmKLpWQql3uQq3T8q)2EhLxNT+qf=tp^uxd5D-m13GuSd;f$+~E@cB8SX7|Nn`mfk+Tw_0sQZNtKK*1lKo UVcsoWXOD*lcxs`B@0M!+0{(!wCjbBd literal 0 HcmV?d00001 From 0148a78c782efea8638647a2b13cbaa9fce761e3 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 14 Feb 2024 15:25:52 -0800 Subject: [PATCH 05/55] cleaned --- .../.GEOS_CatchGridComp.F90.swp | Bin 16384 -> 0 bytes .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 4 ++-- 2 files changed, 2 insertions(+), 2 deletions(-) delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/.GEOS_CatchGridComp.F90.swp diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/.GEOS_CatchGridComp.F90.swp b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/.GEOS_CatchGridComp.F90.swp deleted file mode 100644 index 05d2f5c727c3fc36a26368c9e02e3d9a633b314b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 16384 zcmeI2Yj7l06~|jZQ4mEIMJc6jSZbX>CYxlJb(2&qCo`R7*m;EMnJk-HX*x4^l3shJ zhwh$avnWt%SyWNt2dgM8sS>LAAXoi9eKWhL zNId{BFR_v!1($R|9|Zv|cn8s||D7vukO$(K2n%vlmgP+g!(Ffpws@ zENLyR`gYathLDAR+pAku9xZgNW-VG$wSwwWw8%`0vamgaQ=>zN{#G%KGw?>qz%kmE zkzqNWH=f+bHXK)Zqcl8jXPkjJ191l848$3TGZ1GW&On@jI0OHK3AU<|@=O(QGZ^UPbU!?Hoi5H1Kpzyyc@jr-X zG~x>5|3&d{EBwz2zg6MSDSX45qw)Ww@CAiGOFZnqs}=qX@iRMNwU-tCw8D41C0hSe z#KZhurtm*1{!c6X4+@_+G8+H)#KZA%iNb%U)c>%;pH$+X_SR_p-x3e|_u~qGLg9BP z{5Ql6%HN4^i^l&o@o;=L6#h8zIr6_*;lCmt_Rk4NMdLq4JbYrXr0_?HHz@w~3jZbX z-Na8lIvW2G;!Wb8QTW43{O1+^5OI_It+z+xKS+EZ@tYL>0P#J<$Bv2m-%s2nex<^H zq3{jwi2DDWc$oiBDttfjF#iuI{66C0`0sybH2%HB!~R)S_&vnWqW0gV@Vgbh>DXxe zpApx||9pktMSKhKTNM6N;-?aSLE(22PZDSE>fD6$+a1LFiRTsm6XK^4Usm|-#6L>> z3WfiexJCR`h2KW}4C3Z-otvx}Aev`sYh2Ka#Z2#vJegpAM6#ssOUr+oa#9vYPb;QSsPrSQx z6Sn{R#52VAD*SuIcM!i$;nxxm=bt0r6ODfj@$maq75-h~KE?l1>FPP4SgB91iBcShx(zHaF)0Yx)kEjR_Ji(UYudR0bLDU2o<4| zpl5J)x(>P+nuo@qQD{5#7|v~vLbpTLK;MME2we(Y1YHPS09By{s0bCH95fA0LB~Un z<9vBFbOCfeG!N~9#-XF22XVd?XW-9592$j=fcE3u{T1juXg4$teE@nt^eh(nXP_&g zBD4{D5ziU!gsy-tht7tMhD3ke7jBM}p6+AW>B(8P%oka(+TuQ2vX(hp;JnEiR;$Hp zEO41&FC_D>Z`oBc()!p`JDIcHHe0}Z5(j!!-Nu65?D(aZx(0~=_lrv`SmHismWMh# z*QyC`<~E(xeuUH;w(r}^cCgBpEvJpf)IGPscG}JY_ZSbD<*>x?=;-JGE2PS)WO+6z z{z{Gvjc(aC(ywVAx10gSSj+OP1`psgHpVhT=HxDOeomhTVQhj84Q|`k+jM@t>F^e< zuV>hNwqPQrIiqK%XUa0{&~WdtGqaO9S$F532{t@5G&I=T)<|Wy&d*IJ3gun1MnA$P zHj4%iZ99F-K#!Z@!Jz>b{=+tlEY9)8WR155(WlkG^%x>Dyxt;i>k!_naqQ+IbL-5L zJ>u}@Vz9&#O?QRyy{$xY@brF$WZKPuFLG}nl1$kwv?`yP&6$Nt9vMJGbwfkN>#pr% zjAe8~FO_@I4}ngmN;)%&*&G?r=&03f@lp@En>Pc`=04#B+CMzRR&2Bvrp)IS69Y)R ztHbOn@0W;-?WVMG_@Y%^WmUJv*$QWEzcV!DFyGF!zErL}CP20Ad8o}<6(({>vTZcl z6F$d~U2vB<@;mXLU%kHlHj$g1snQfHmvr4=iE^coDWyaQuDebbnJN`inVg=QV#Z9V zGHLX(+X}nsQW1ezx;Uqodf9A&O+nWYN(Pga_p%#_)S1!K*-WKaF*>d7ND`?}j zI1IY560J`!&T4&{)@m;}m{AQL7~EUN@WpwtkM+$~CUe;|%j@|`y~L&}g>*SvEEvdA z%d?jeO0yd+INAYgx=pSzhX2Hv?Yy71;#n=zN2Yn+t!aH5lgS9Sn^g~`mSW6ZY~EN5YWs=y3VHGS81%!X_GL8Q3F@kX48 zv4R$O4qxUDRvgy3X7yA#oip<0Y_U`{%<@c0H)e{tOvsH~aaJc=d`x_prQtAR8inFc zQ$jJjGqy>SAL#PJ&QxyFEM!ah)LE)Sr&M~V4s%(fheM|{>QI^~P8n1iKB7&MP-#-Z zoG!1~uQ`bFj%kN>n^cfruj|sSp;Nx*A{;~qbyAYXkSM1LWux0i-3Z~$rf%Miz~+mN z9qbc75mR=b<>M9+<%NmdG>ptF)>V0D%!PM5(Pk>k46Nl{7FD_qm99gj>rgRNhhjQ( zD5gV)Vmfp{nd&gvb(rirOm-bmraEN0P0Dnel<77JWf2Ec<}e%S6-vl~AKi}Xk;R}T z(zw<~((fP+!qUXAh}Ya64x(p`a#o+tWy|woybBxp^&QxnZVeih%3pm0D;EmHEFgzR zUN4l*d@-ZvUT1g+kBnz6rd?jIV@^RFU(6ewSmK3Svx2EqEn71Y8v(M`jrYcm*aO+v(2C_C+2B?a)3AKm zmz~?TngQl=?hmrE+)JQYm@rXo4GBSu)-uA-Xf&d;=jg00zT9}!cwNks(kmOtMp!IZ zag&{vdu{BZId;CaP91gI^8@-;?t;vLbj4N$ZfGL&TX+$fb;8!z!m6y&ZZ2`p7Hf#( zqPwv(LJVw58=Y^7o!k!B7rR}#MIK~{5$rGf2U!YD2DAfT03^%2flUQ*z8iH%l!uPhtX#Q{ZbqC)G;yl*rL+pQ3xm+=ACQ|*(t|u(tcdNG8 z51^nQxoD23CWgjAzU%ngX{>vc`nt>SfGHmukUxluME`vS|eF}1+ zCX|OntQ}B%#Tke*5N9CHK%9X%191l848$3TGZ1GW&cOd^25{I69}4w8k!!*N56$Ue zG%HmKLpWQql3uQq3T8q)2EhLxNT+qf=tp^uxd5D-m13GuSd;f$+~E@cB8SX7|Nn`mfk+Tw_0sQZNtKK*1lKo UVcsoWXOD*lcxs`B@0M!+0{(!wCjbBd diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 1a65bc4e5..bc71b7e8f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5093,7 +5093,7 @@ subroutine Driver ( RC ) ! Add irrigation model imports ! -------------------------------------------------------------------------- - if(CATCH_INTERNAL_STATE%RUN_IRRIG == 1) then + if(CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) then where (SPRINKLERRATE > 0) PLS_IN = PLS_IN + SPRINKLERRATE end where @@ -5750,7 +5750,7 @@ subroutine Driver ( RC ) if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT if(associated(IRRLAND)) then - if (CATCH_INTERNAL_STATE%RUN_IRRIG == 1) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE + if (CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE endif if(associated(SNOLAND)) SNOLAND = SLDTOT ! note, not just SNO if(associated(DRPARLAND)) DRPARLAND = DRPAR From 1cc0a9704b4e8167422048505f9699f65236eacc Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Thu, 15 Feb 2024 15:57:36 -0800 Subject: [PATCH 06/55] Bug Fix --- .../GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index aa2abdc9d..ed4e9a5c5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -52,7 +52,7 @@ module GEOS_IrrigationGridCompMod public SetServices integer :: IRRIG_METHOD, IRRIG_TRIGGER - logical :: RUN_IRRIG + integer :: RUN_IRRIG type IRRIG_WRAP type (irrig_params), pointer :: PTR => null() @@ -130,14 +130,14 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) - call ESMF_ConfigGetAttribute (SCF, label='RUN_IRRIG:' , value=RUN_IRRIG , DEFAULT=.false., __RC__ ) + call ESMF_ConfigGetAttribute (SCF, label='RUN_IRRIG:' , value=RUN_IRRIG , DEFAULT=0, __RC__ ) call ESMF_ConfigGetAttribute (SCF, label='IRRIG_TRIGGER:', value=IRRIG_TRIGGER,DEFAULT=0, __RC__ ) call ESMF_ConfigGetAttribute (SCF, label='IRRIG_METHOD:' , value=IRRIG_METHOD, DEFAULT=0, __RC__ ) call ESMF_ConfigDestroy (SCF, __RC__) ! Leave GEOSirrigation_GridComp if RUN_IRRIG == .FALSE. - if(.not. RUN_IRRIG) then + if(RUN_IRRIG == 0) then RETURN_(ESMF_SUCCESS) endif From 62a39ea677b4b2bcce5d52f29e59ff534a48ff93 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Fri, 16 Feb 2024 13:07:17 -0800 Subject: [PATCH 07/55] bug fixed --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 6 +++--- .../GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 5f6a76c77..2c0d19428 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -1345,9 +1345,9 @@ subroutine SetServices ( GC, RC ) END SELECT if (RUN_IRRIG == 1) then - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPRINKLERRATE', CHILD_ID = IRRIGATION(0),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FLOODRATE', CHILD_ID = IRRIGATION(0),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRIPRATE', CHILD_ID = IRRIGATION(0),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPRINKLERRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FLOODRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRIPRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index ed4e9a5c5..fca77febb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -136,7 +136,7 @@ subroutine SetServices ( GC, RC ) call ESMF_ConfigDestroy (SCF, __RC__) - ! Leave GEOSirrigation_GridComp if RUN_IRRIG == .FALSE. + ! Leave GEOSirrigation_GridComp if RUN_IRRIG == 0 if(RUN_IRRIG == 0) then RETURN_(ESMF_SUCCESS) endif From a3a560ab494c70057680e5e373525e8ef3f75795 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 24 Apr 2024 11:43:28 -0700 Subject: [PATCH 08/55] added module_irrig_params.F90 in makebcs --- .../Raster/makebcs/module_irrig_params.F90 | 1657 +++++++++++++++++ 1 file changed, 1657 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 new file mode 100755 index 000000000..0ac384e31 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -0,0 +1,1657 @@ +#define VERIFY_(A) IF(A/=0)THEN;PRINT *,'ERROR AT LINE ', __LINE__;STOP;ENDIF +#define ASSERT_(A) if(.not.A)then;print *,'Error:',__FILE__,__LINE__;stop;endif + +module module_irrig_params + + use rmTinyCatchParaMod, ONLY : RegridRaster,regridrasterreal + use process_hres_data, ONLY : get_country_codes + use MAPL + + implicit none + + INCLUDE 'netcdf.inc' + + private + + public :: create_irrig_params + +contains + + subroutine create_irrig_params (nc, nr, gfile) + + implicit none + + integer , intent (in) :: nc, nr + character(*) , intent (in) :: gfile + REAL, PARAMETER :: UNDEF = -9999., UNDEFG = 1.e15 + + ! GRIPC data + ! ---------- + + integer, parameter :: NX_gripc = 86400 + integer, parameter :: NY_gripc = 43200, NY_GripcData = 36000 + character*300, parameter :: GRIPC_file = 'data/CATCH/IRRIGATION/irrigtype_salmon2013.flt' + real, allocatable, dimension (:) :: IGRIPC, RGRIPC, PGRIPC, NGRIPC + + ! MIRCA2000 data + ! -------------- + + integer, parameter :: NX_mirca = 4320 + integer, parameter :: NY_mirca = 2160 + integer, parameter :: NCROPS = 26, NMON = 12, STRLEN = 20 + real, parameter :: DXY_mirca= 360./REAL(NX_mirca) + real, parameter :: lat1_mirca = 90.0 - DXY_mirca / 2.0 !1st grid center lat + real, parameter :: lon1_mirca = -180.0 + DXY_mirca / 2.0 !1st grid center lon + character*300, parameter :: MIRCA_path = 'data/CATCH/IRRIGATION/crop_' + real, allocatable, dimension(:,:,:) :: MIFRAC, MRFRAC + + ! Global Irrigated Area data (GIA) + ! -------------------------------- + + integer, parameter :: NX_GIA = 43200 + integer, parameter :: NY_GIA = 21600, NY_GIAData = 18000 + character*300, parameter :: GIA_file = 'data/CATCH/IRRIGATION/global_irrigated_areas.nc4' + real, allocatable, dimension (:) :: GIAFRAC + + ! LAI data + ! -------- + + integer, parameter :: NX_LAI = 86400 + integer, parameter :: NY_LAI = 43200 + character*300, parameter :: LAI_file = '/discover/nobackup/projects/lis/LS_PARAMETERS/MODIS/MCD15A2H.006/MCD15A2H.006_LAI_YYYY' + + ! Irrigation Method + ! ----------------- + character*300, parameter :: IM_path = 'data/CATCH/IRRIGATION/' + + ! Global/Local variables + ! ---------------------- + + integer, allocatable, dimension (:,:) :: tile_id + integer :: i,j, NTILES, STATUS, tindex1,pfaf1, NCOutID + real, allocatable, dimension (:) :: tile_lon, tile_lat + real :: minlon,maxlon,minlat,maxlat + + !The codes for the 26 crop classes are as follows: + !1 Wheat + !2 Maize + !3 Rice + !4 Barley + !5 Rye + !6 Millet + !7 Sorghum + !8 Soybeans + !9 Sunflower + !10 Potatoes + !11 Cassava + !12 Sugar cane + !13 Sugar beet + !14 Oil palm + !15 Rape seed / Canola + !16 Groundnuts / Peanuts + !17 Pulses + !18 Citrus + !19 Date palm + !20 Grapes / Vine + !21 Cotton + !22 Cocoa + !23 Coffee + !24 Others perennial + !25 Fodder grasses + !26 Others annual + + character(len=STRLEN),dimension(ncrops) :: cname = (/"Wheat ", & + "Maize ", "Rice ", "Barley ", & + "Rye ", "Millet ", "Sorghum ", & + "Soybeans ", "Sunflower ", "Potatoes ", & + "Cassava ", "Sugar cane ", "Sugar beet ", & + "Oil palm ", "Rape seed /Canola ", "Groundnuts/ Peanuts ", & + "Pulses ", "Citrus ", "Date palm ", & + "Grapes / Vine ", "Cotton ", "Cocoa ", & + "Coffee ", "Other sperennial ", "Fodder grasses ", & + "Others annual "/) + + ! (1) Reading rst file and NTILES + ! ------------------------------- + + open (10,file= trim(gfile)//'.rst',status='old',action='read', & + form='unformatted',convert='little_endian') + allocate (tile_id (1:nc,1:nr)) + + do j=1,nr + read(10)tile_id(:,j) + end do + close (10,status='keep') + + open (10,file='clsm/catchment.def',status='old',action='read', form='formatted') + read (10, *) ntiles + allocate (tile_lon (1:NTILES)) + allocate (tile_lat (1:NTILES)) + do i = 1, NTILES + read (10,*) tindex1,pfaf1,minlon,maxlon,minlat,maxlat + tile_lon(i) = (minlon + maxlon)/2. + tile_lat(i) = (minlat + maxlat)/2. + end do + close (10, status = 'keep') + + call OpenFile + + ! (3) Process GIA + ! ----------------- + + allocate (GIAFRAC (NTILES)) + call ReadProcess_GIA (NC, NR, NTILES, tile_id, GIAFRAC) + + ! (4) Process GRIPC and MCD15A2H LAI + ! ---------------------------------- + + allocate (IGRIPC (NTILES)) + allocate (RGRIPC (NTILES)) + allocate (PGRIPC (NTILES)) + allocate (NGRIPC (NTILES)) + call ReadProcess_GRIPC (NC, NR, NTILES, tile_id, IGRIPC, RGRIPC, PGRIPC, NGRIPC) + + ! (1) Process MIRCA2000 + ! --------------------- + + allocate (MIFRAC (NTILES, 12, NCROPS)) + allocate (MRFRAC (NTILES, 12, NCROPS)) + call ReadProcess_MIRCA (NC, NR, NTILES, tile_id, MIFRAC, MRFRAC) + + ! (5) Create parameter file for the model + ! --------------------------------------- + + call MergeData (NTILES) + + return + + contains + + ! =========================================================================================== + + SUBROUTINE OpenFile + + implicit none + integer :: i, m, n,l, lid, mid, cid, vid, sid + integer, dimension(8) :: date_time_values + character (22) :: time_stamp + character (len=STRLEN) :: ThisCrop + real :: abm_int, peatf_r, gdp_r, hdm_r + real, dimension (:), allocatable :: field_cap + + status = NF_CREATE ('clsm/irrig.dat' , NF_NETCDF4, NCOutID) ; VERIFY_(STATUS) + status = NF_DEF_DIM(NCOutID, 'tile' , NTILES, lid) ; VERIFY_(STATUS) + status = NF_DEF_DIM(NCOutID, 'unknown_dim1', NCROPS, cid) ; VERIFY_(STATUS) + status = NF_DEF_DIM(NCOutID, 'unknown_dim2', 2, mid) ; VERIFY_(STATUS) + status = NF_DEF_DIM(NCOutID, 'strlen' , STRLEN, sid) ; VERIFY_(STATUS) + + ! GIA -> GRIPC MERGE + ! ------------------ + + status = NF_DEF_VAR(NCOutID, 'RAINFEDFRAC' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of rainfed cropland'), & + 'fraction of rainfed cropland') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'IRRIGFRAC' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of irrigated cropland'), & + 'fraction of irrigated cropland') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'PADDYFRAC' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of paddy cropland'), & + 'fraction of paddy cropland') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'FIELDCAP' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('soil field capacity'), & + 'soil field capacity') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 5,'m3/m3') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + ! GIA- GRIPC -> MIRCA + ! ------------------- + + status = NF_DEF_VAR(NCOutID, 'CROPCLASSNAME' , NF_CHAR, 2 ,(/sid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Crop Class Name'), & + 'Crop Class Name') ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'CROPIRRIGFRAC' , NF_FLOAT, 2 ,(/lid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Crop irrigated fraction'), & + 'Crop irrigated fraction') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'CROPRAINFEDFRAC' , NF_FLOAT, 2 ,(/lid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Crop rainfed fraction'), & + 'Crop rainfed fraction') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + ! Crop calendar + ! ------------- + + status = NF_DEF_VAR(NCOutID, 'IRRIGPLANT' , NF_FLOAT, 3 ,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('DOY start planting'), & + 'DOY start planting') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 4,'days') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'IRRIGHARVEST' , NF_FLOAT, 3 ,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('DOY end harvesting'), & + 'DOY end harvesting') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 4,'days') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'RAINFEDPLANT' , NF_FLOAT, 3 ,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('DOY start planting'), & + 'DOY start planting') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 4,'days') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'RAINFEDHARVEST' , NF_FLOAT, 3,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('DOY end harvesting'), & + 'DOY end harvesting') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 4,'days') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + + ! IRRIG TYPE + ! ---------- + + status = NF_DEF_VAR(NCOutID, 'IRRIGTYPE' , NF_FLOAT, 2 ,(/lid, cid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', & + LEN_TRIM('Preferred Irrig Type : Concurrent (0) SPRINKLER(1) DRIP(2) FLOOD(3) AVOID (negative)'), & + 'Preferred Irrig Type : Concurrent (0) SPRINKLER(1) DRIP(2) FLOOD(3) AVOID (negative)') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'SPRINKLERFR' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of sprinkler irrigation'), & + 'fraction of sprinkler irrigation') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'DRIPFR' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of drip irrigation'), & + 'fraction of drip irrigation') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'FLOODFR' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of flood irrigation'), & + 'fraction of flood irrigation') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + ! LAI + ! --- + status = NF_DEF_VAR(NCOutID, 'LAIMIN' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Minimum LAI irrigated crops'), & + 'Minimum LAI irrigated crops') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + status = NF_DEF_VAR(NCOutID, 'LAIMAX' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Maximum LAI irrigated crops'), & + 'Maximum LAI irrigated crops') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) + status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) + + call date_and_time(VALUES=date_time_values) + + write (time_stamp,'(i4.4,a1,i2.2,a1,i2.2,1x,a2,1x,i2.2,a1,i2.2,a1,i2.2)') & + date_time_values(1),'-',date_time_values(2),'-',date_time_values(3),'at', & + date_time_values(5),':',date_time_values(6),':',date_time_values(7) + + status = NF_PUT_ATT_TEXT(NCOutID, NF_GLOBAL, 'CreatedBy', LEN_TRIM('Sarith Mahanama'), & + 'Sarith Mahanama') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, NF_GLOBAL, 'Contact' , LEN_TRIM('sarith.p.mahanama@nasa.gov'), & + 'sarith.p.mahanama@nasa.gov') + status = NF_PUT_ATT_TEXT(NCOutID, NF_GLOBAL, 'Date' , LEN_TRIM(time_stamp),trim(time_stamp)) + + status = NF_ENDDEF(NCOutID) + + DO n = 1, NCROPS + i = LEN_TRIM(cname(n)) + ThisCrop = trim(cname(n)) + status = NF_PUT_VARA_text(NCOutID,VarID(NCOutID,'CROPCLASSNAME') ,(/1,n/),(/i,1/),ThisCrop (1:i)) ; VERIFY_(STATUS) + END DO + + ! Put field capacity + + open (10,file='clsm/CLM4.5_abm_peatf_gdp_hdm_fc', & + form='formatted',status='old',action = 'read') + allocate (field_cap(1:NTILES)) + + do n = 1, NTILES + read (10,'(2I8, i3, f8.4, f8.2, f10.2, f8.4)' ) i, vid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(n) + end do + + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'FIELDCAP' ) ,(/1/),(/NTILES/),field_cap ) ; VERIFY_(STATUS) + close (10, status = 'keep') + deallocate (field_cap) + + + END SUBROUTINE OpenFile + + ! ----------------------------------------------------------------------------------------- + + SUBROUTINE MergeData (NTILES) + + implicit none + integer, intent (in) :: NTILES + real, allocatable, dimension (:,:) :: MI, MR + real :: MICROP, MRCROP, MIRICEA, MRRICEA, MICROPA, MRCROPA, DF, SF, FF, ITYPE(3) + integer :: i, j, m, n,l, t + real, dimension (:), ALLOCATABLE :: sprinkler, drip, flood + integer :: nc, day1, dayL, day1_2, dayL_2 + integer, dimension (12) :: fmonth, fmonth2, fmonth3 + integer, dimension (12) :: DOY_MidMonth, DOY_BegMonth, DOY_EndMonth + logical, dimension (4) :: found = .false. + integer, allocatable , dimension (:) :: crop_mons + real, allocatable, dimension (:,:,:) :: IRRIGPLANT, IRRIGHARVEST, RAINFEDPLANT, RAINFEDHARVEST + real, allocatable, dimension (:,:) :: IRRIGTYPE + + data DOY_BegMonth / 1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335/ + data DOY_MidMonth /15, 46, 74, 105, 135, 166, 196, 227, 258, 288, 319, 349/ + data DOY_EndMonth /31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 366/ + + ALLOCATE (FLOOD (1:NTILES)) + ALLOCATE (SPRINKLER(1:NTILES)) + ALLOCATE (DRIP (1:NTILES)) + CALL ReadProcess_IMethod (NTILES, sprinkler, drip, flood) + + ! MERGING PROCEDURE + ! ================= + ! CROP CALENDAR + ! GIA GIA-GRIPC GIA-GRIPC-MIRCA ------------- + ! --- --------- --------------- + ! CAL_STEP 1 : USE MIRCA monthly crop fractions : + ! -> NO -> 100% iCrop -> YES scale to match GIA-GRIPC 1) Year around : 366 + ! | | 1) MIRCA type 3 is paddy 2) if not year around check whether 1 or 2 seasons + ! | | 2) Scale fractions to match + ! | | the sum of individual crops CAL_STEP 2 : Look for gaps in calendar for GIA-GRIPC-MIRCA and + ! GIA -> GRIPC_| -> MIRCA -| to GIA-GRIPC use nearest neighbor with similar crop type + ! HAVE | | iCrop | + ! | | | -> YES Scale to match GIA-GRIPC + ! | |-> iCrop | | | 1) MIRCA type 3 is paddy + ! | | | | | 2) Scale fractions to match + ! | | | | | the sum of individual crops + ! |-> YES|-> Paddy | |-> NO ->MIRCA -| to GIA-GRIPC + ! | | rCrop | 3) set MIRCA rCrop to zero. + ! | | | + ! |-> rCrop | |-> NO Plant Wheat GIA-GRIPC frac + ! | + ! | + ! | -> YES Max (GIA-GRIPC, MIRCA rCrop) + ! | | 1) MIRCA type 3 is paddy + ! | | 2) Scale fractions to match + ! | | the sum of individual crops + ! | ->MIRCA -| to GIA-GRIPC-MIRCA + ! rCrop | + ! |-> NO Plant Wheat + + allocate (MI (1 : NTILES, 1 : NCROPS)) + allocate (MR (1 : NTILES, 1 : NCROPS)) + allocate (IRRIGPLANT (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (IRRIGHARVEST (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (RAINFEDPLANT (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (RAINFEDHARVEST (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (IRRIGTYPE (1 : NTILES, 1 : NCROPS)) + + MI = 0. + MR = 0. + IRRIGTYPE = 0 + + IRRIGPLANT = 998 + IRRIGHARVEST = 998 + RAINFEDPLANT = 998 + RAINFEDHARVEST = 998 + + ! Compute annual maximum fractions from MIRCA monthly fractions : + ! (1) crop specific and (2) paddy and irrigated crops, seperately for rainfed and irrigated + + DO m = 1,12 + DO I = 1, NTILES + IF((maxval(MIFRAC (I,m,:)) > 0.).OR.(maxval(MRFRAC (I,m,:)) > 0.)) then + DO N = 1, NCROPS + ! Maximum Crop Fraction over 12 months + IF(MI (I,n) < MIFRAC (I,m,n)) MI (I,N) = MIFRAC (I,m,n) + IF(MR (I,n) < MRFRAC (I,m,n)) MR (I,N) = MRFRAC (I,m,n) + END DO + ENDIF + END DO + END DO + + ! CROP CALENDAR CAL_STEP1 : Compute plant/harvest dates and create HYBRID of GRIPC and MIRCA fractions + ! ---------------------------------------------------------------------------------------------------- + + DO I = 1, NTILES + IF((maxval(MI (I,:)) > 0.).OR.(maxval(MR (I,:)) > 0.).OR.(IGRIPC (I) > 0.).OR.(PGRIPC (I) > 0.).OR.(RGRIPC (I) > 0.)) THEN + + ! Crop planting/Harvesting days + ! ----------------------------- + ! OUTPPUTS IRRIGPLANT, IRRIGHARVEST, RAINFEDPLANT, RAINFEDHARVEST + + forall (m=1:12) fmonth3(m) = m + + DO N = 1, NCROPS + + fmonth = 0. + fmonth2 = 0. + + DO t = 1,2 + + if (t == 1) nc = count (MIFRAC (i,:,n) > 0.) + if (t == 2) nc = count (MRFRAC (i,:,n) > 0.) + + if(nc > 0) then + + if(nc == 12) then + ! year around + + day1 = 1 + dayL = 366 + day1_2 =998 + dayL_2 =998 + + else + + fmonth = 0. + fmonth2 = 0. + day1 = 998 + dayL = 998 + day1_2 = 998 + dayL_2 = 998 + + if (t == 1) forall (m=1:12) fmonth(m) = ceiling (MIFRAC (i,m,n)) + if (t == 2) forall (m=1:12) fmonth(m) = ceiling (MRFRAC (i,m,n)) + + fmonth2(1) = 1 + do m = 2,12 + if(fmonth(m) == fmonth(m-1)) then + fmonth2 (m) = fmonth2(m-1) + else + fmonth2 (m) = fmonth2(m-1) + 1 + endif + end do + + if(maxval (fmonth2) > 3) then + + ! This crop grows in 2 seasons + ! ............................ + + allocate (crop_mons (1:NC)) + crop_mons = pack(fmonth3, mask = (fmonth > 0.)) + found = .false. + + if(fmonth(1) == 1) then + if(fmonth(12) == 0) then + ! Season begins on Jan 1 + day1 = DOY_BegMonth(crop_mons(1)) + found(1) = .true. + do m = 1, nc-1 + if((crop_mons(m+1) - crop_mons(m)) > 1) then + dayL = DOY_EndMonth(crop_mons(m)) + day1_2 = DOY_BegMonth(crop_mons(m+1)) + dayL_2 = DOY_EndMonth(crop_mons(nc)) + found(2) = .true. + found(3) = .true. + found(4) = .true. + exit + endif + enddo + else + ! season one begins in the fall + do m = 1, nc-1 + if((crop_mons(m+1) - crop_mons(m)) > 1) then + if(.not.found(2)) then + dayL = DOY_EndMonth(crop_mons(m)) + day1_2 = DOY_BegMonth(crop_mons(m+1)) + found(2) = .true. + found(3) = .true. + elseif (.not.found(4)) then + found(4) = .true. + found(1) = .true. + dayL_2 = DOY_EndMonth(crop_mons(m)) + day1 = DOY_BegMonth(crop_mons(m+1)) + endif + endif + end do + endif + else + + ! season 1 brings in the spring + day1 = DOY_BegMonth(crop_mons(1)) + found(1) = .true. + do m = 1, nc-1 + if((crop_mons(m+1) - crop_mons(m)) > 1) then + dayL = DOY_EndMonth(crop_mons(m)) + day1_2 = DOY_BegMonth(crop_mons(m+1)) + dayL_2 = DOY_EndMonth(crop_mons(nc)) + found(2) = .true. + found(3) = .true. + found(4) = .true. + exit + endif + enddo + endif + deallocate (crop_mons) + + else + + ! Single crop season + ! .................. + if((fmonth(1) == 0).and.(fmonth(12) == 0)) then + day1 = DOY_BegMonth (maxloc(fmonth, 1)) + dayL = DOY_EndMonth (maxloc(fmonth2, 1)-1) + else + if((fmonth(1) == 1).and.(fmonth(12) == 1)) then + day1 = DOY_BegMonth (maxloc(fmonth2, 1,mask=(fmonth2 > 2))) + dayL = DOY_EndMonth (maxloc(fmonth2, 1,mask=(fmonth2 == 2))-1) + endif + if((fmonth(1) == 0).and.(fmonth(12) == 1)) then + day1 = DOY_BegMonth (maxloc(fmonth2, 1)) + dayL = DOY_EndMonth (12) + endif + if((fmonth(1) == 1).and.(fmonth(12) == 0)) then + day1 = DOY_BegMonth (1) + dayL = DOY_EndMonth (maxloc(fmonth2, 1)-1) + endif + endif + endif + + if (t == 1) then + IRRIGPLANT (I,1,N) = day1 + IRRIGPLANT (I,2,N) = day1_2 + IRRIGHARVEST (I,1,N) = dayL + IRRIGHARVEST (I,2,N) = dayL_2 + else + RAINFEDPLANT (I,1,N) = day1 + RAINFEDPLANT (I,2,N) = day1_2 + RAINFEDHARVEST (I,1,N) = dayL + RAINFEDHARVEST (I,2,N) = dayL_2 + endif + endif + endif + END DO + END DO + + ! 1. Main Fractions (OUTPUT) : + ! 1.1 IRRIGFRAC : The maximum value between (1) GRIPC irrigfrac, and (2) sum of MIRCA monthly crop frations without rice + ! 1.2 PADDYFRAC : The maximum value between (1) GRIPC paddyfrac, and (2) monthly rice fractions from MIRCA + ! 1.3 RAINFEDFRAC : The maximum value between (1) GRIPC rainfedfrac, and (2) sum of MIRCA monthly crop frations + ! 1.4 MI (I,CROPS) : Irrigated crop fractions with rice is the 3rd slice crops = 3 + ! 1.5 MR (I,CROPS) : rainfed crop fractions with rice is the 3rd slice crops = 3 + + MICROP = 0. + MRCROP = 0. + MIRICEA= 0. + MRRICEA= 0. + MICROPA= 0. + MRCROPA= 0. + + DO N = 1, NCROPS + IF (n == 3) THEN + IF(MIRICEA < MI (I,n)) MIRICEA = MI (I,n) + IF(MRRICEA < MR (I,n)) MRRICEA = MR (I,n) + ELSE + MICROP = MICROP + MI (I,n) + MRCROP = MRCROP + MR (I,n) + ENDIF + END DO + + IF(MICROPA < MICROP) MICROPA = MICROP + IF(MRCROPA < MRCROP) MRCROPA = MRCROP + + ! GIA-GRIPC + ! ......... + + IF(GIAFRAC (I) <= 0 ) THEN + ! MASK OUT non-irrigated per GIA + RGRIPC (I) = RGRIPC (I) + IGRIPC (I) + PGRIPC (I) + IGRIPC (I) = 0. + PGRIPC (I) = 0. + ELSE + IF ((IGRIPC (I) + PGRIPC (I)) < 0.) THEN + ! GRIPC does not have data + PGRIPC (I) = 0. + IGRIPC (I) = GIAFRAC (I) + ELSE + ! GRIPC HAVE DATA + MICROP = PGRIPC (I) + IGRIPC (I) + 1.e-15 ! RGRIPC (I) + IF (GIAFRAC (I) > MICROP) THEN + PGRIPC (I) = PGRIPC (I) * GIAFRAC (I) / MICROP + IGRIPC (I) = IGRIPC (I) * GIAFRAC (I) / MICROP + ENDIF + ENDIF + ENDIF + + if ((RGRIPC(I) + IGRIPC(I) + PGRIPC(I) + NGRIPC(I)) > 0.) then + RGRIPC (I) = RGRIPC (I) /(RGRIPC(I) + IGRIPC(I) + PGRIPC(I) + NGRIPC(I)) + NGRIPC(I) = NGRIPC(I) /(RGRIPC(I) + IGRIPC(I) + PGRIPC(I) + NGRIPC(I)) + endif + + ! GIA-GRIPC-MIRCA IRRIGATED CROPS + ! ............................... + + IF (IGRIPC(I) == 0) THEN + DO N = 1, NCROPS + IF(N /= 3) MI (I,N) = 0. + END DO + ELSE + ! IF(MICROPA > IGRIPC (I)) THEN + ! + ! ! MIRCA is the larger fraction + ! IGRIPC (I) = MICROPA + ! ! CALL STOPIT (1, IGRIPC (I), MICROPA, MI (I,:)) + ! ELSE + + IF(MICROPA > 0.) THEN + + ! MIRCA has data too, thus scale crop fractions to match GIA-GRIPC (i.e. GIA) + DO N = 1, NCROPS + IF(N /= 3) MI (I,N) = MI (I,N) * IGRIPC (I) / MICROPA + END DO + ! CALL STOPIT (2, IGRIPC (I), MICROPA, MI (I,:)) + + ELSE + + ! MIRCA does not have data but GRIPC has + IF(MRCROPA > 0.) THEN + + ! Looks like MIRCA rainfed frac has data + DO N = 1, NCROPS + IF(N /= 3) THEN + MI (I,N) = MR (I,N) * IGRIPC (I) / MRCROPA + MR (I,N) = 0. + IRRIGPLANT (I,1,N) = RAINFEDPLANT (I,1,N) + IRRIGPLANT (I,2,N) = RAINFEDPLANT (I,2,N) + IRRIGHARVEST (I,1,N) = RAINFEDHARVEST (I,1,N) + IRRIGHARVEST (I,2,N) = RAINFEDHARVEST (I,2,N) + ENDIF + END DO + ! CALL STOPIT (3, IGRIPC (I), MICROPA, MI (I,:)) + MRCROPA = 0. + + ELSE + + ! MIRCA irrigated and rainfed do not have data plant some wheat + MI (I,1) = IGRIPC (I) + IRRIGPLANT (I,1,1) = 999 + IRRIGPLANT (I,2,1) = 0 + IRRIGHARVEST (I,1,1) = 999 + IRRIGHARVEST (I,2,1) = 0 + ! CALL STOPIT (4, IGRIPC (I), MICROPA, MI (I,:)) + ENDIF + ! ENDIF + ENDIF + ENDIF + + ! CALL STOPIT (5, IGRIPC (I), MICROPA, MI (I,:)) + + ! GIA-GRIPC-MIRCA PADDY + ! ..................... + IF(PGRIPC (I) == 0.) THEN + MI (I,3) = 0. + ELSE + ! IF(MIRICEA > PGRIPC (I)) THEN + ! + ! ! MIRCA is the larger fraction + ! PGRIPC (I) = MIRICEA + ! + ! ELSE + + IF(MIRICEA > 0.) THEN + + ! MIRCA has data too, thus scale crop fractions to match GRIPC + MI (I,3) = MI (I,3) * PGRIPC (I) / MIRICEA + + ELSE + + ! MIRCA does not have data but GRIPC has + IF(MRRICEA > 0.) THEN + + ! Looks like MIRCA rainfed frac has rice + MI (I,3) = MR (I,3) * PGRIPC (I) / MRRICEA + MR (I,3) = 0. + MRRICEA = 0. + IRRIGPLANT (I,1,3) = RAINFEDPLANT (I,1,3) + IRRIGPLANT (I,2,3) = RAINFEDPLANT (I,2,3) + IRRIGHARVEST (I,1,3) = RAINFEDHARVEST (I,1,3) + IRRIGHARVEST (I,2,3) = RAINFEDHARVEST (I,2,3) + ELSE + + ! MIRCA irrigated and rainfed do not have data plant rice to PGRIPC + MI (I,3) = PGRIPC (I) + + ! Get crop planting days for the nearest neighbor later + + IRRIGPLANT (I,1,3) = 999 + IRRIGPLANT (I,2,3) = 0 + IRRIGHARVEST (I,1,3) = 999 + IRRIGHARVEST (I,2,3) = 0 + + ENDIF + ENDIF + ! ENDIF + ENDIF + + ! GIA-GRIPC-MIRCA Rainfed CROPS + ! ............................. + + IF( RGRIPC (I) == 0.) THEN + MR (I,:) = 0. + ELSE + + ! IF(MRCROPA + MRRICEA > RGRIPC (I)) THEN + ! + ! ! MIRCA is the larger fraction + ! RGRIPC (I) = MRCROPA + MRRICEA + ! + ! ELSE + IF(MRCROPA + MRRICEA > 0.) THEN + + ! MIRCA has data too, thus scale crop fractions to match GRIPC + DO N = 1, NCROPS + IF(N /= 3) MR (I,N) = MR (I,N) * RGRIPC (I) / (MRCROPA + MRRICEA) + END DO + + IF (MRRICEA > 0.) MR (I,3) = MR (I,3) * RGRIPC (I) / (MRCROPA + MRRICEA) + + ELSE + + ! MIRCA does not have data but GRIPC has + ! MIRCA rainfed do not have data plant some wheat + MR (I,1) = RGRIPC (I) + RAINFEDPLANT (I,1,1) = 999 + RAINFEDPLANT (I,2,1) = 0 + RAINFEDHARVEST (I,1,1) = 999 + RAINFEDHARVEST (I,2,1) = 0 + ENDIF + ENDIF + ! ENDIF + + ! IRRIGTYPE + + DO N = 1, NCROPS + FF = FLOOD (I) + SF = SPRINKLER (I) + DF = DRIP (I) + IF(N == 3) THEN ! Rice + SF = 0. + DF = 0. + FF = 1. + IRRIGTYPE (I, N) = 3 ! Always flood + ENDIF + IF(N == 10) IRRIGTYPE (I, N) = -1 ! never sprinkler + IF(N == 22) IRRIGTYPE (I, N) = -1 ! never sprinkler + !IF(N == 10) SF = 0. ! Date palm + !IF(N == 22) SF = 0. ! Cocoa + !ITYPE = (/SF, DF, FF/) + !IRRIGTYPE (I, N) = maxloc(ITYPE, 1) + END DO + ENDIF + END DO + + ! CROP CALENDAR CAL_STEP2 Update missing plant harvest dates + ! ---------------------------------------------------------- + + DO I = 1, NTILES + DO N = 1,3,2 + + ! fill missing crop plant/harvest DOYs in irrigated crops + ! ....................................................... + + IF((IRRIGPLANT(I,1,N) == 999).AND.(MI (I,N) > 0.)) THEN + l = getNeighbor (I,day_in = IRRIGPLANT (:,1,N)) + IRRIGPLANT (I,1,N) = IRRIGPLANT (l,1,N) + IRRIGHARVEST(I,1,N) = IRRIGHARVEST(l,1,N) + if(N == 1) then + IF(RAINFEDPLANT(I,1,N) == 999) THEN + RAINFEDPLANT (I,1,N) = IRRIGPLANT (l,1,N) + RAINFEDHARVEST(I,1,N) = IRRIGHARVEST(l,1,N) + ENDIF + endif + endif + + IF(N == 1) THEN + ! fill missing crop plant/harvest DOYs in rainfed crops + ! ..................................................... + ! temperorily commented out to save time, because we don't irrigate here anyway + ! IF((RAINFEDPLANT(I,1,N) == 999).AND.(MR (I,N) > 0.)) THEN + ! print *,'RAINFEDPLANT(I,1,N)',I,N, MR (I,N) + ! l = getNeighbor (I,day_in = IRRIGPLANT (:,1,N)) + ! RAINFEDPLANT (I,1,N) = IRRIGPLANT (l,1,N) + ! RAINFEDHARVEST(I,1,N) = IRRIGHARVEST(l,1,N) + ! endif + ENDIF + END DO + if(((IRRIGPLANT (I,1,1) == 999).and.(MI (i,1) > 0.)).OR. & + ((IRRIGPLANT (I,1,3) == 999).and.(MI (i,3) > 0.))) then + print *, i, IRRIGPLANT (I,1,1:3), MI (i,1:3) + stop + endif + END DO + + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGFRAC' ) ,(/1/),(/NTILES/),IGRIPC ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'PADDYFRAC' ) ,(/1/),(/NTILES/),PGRIPC ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDFRAC') ,(/1/),(/NTILES/),RGRIPC ) ; VERIFY_(STATUS) + + do n = 1,NCROPS + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'CROPIRRIGFRAC' ) ,(/1,n/),(/NTILES,1/),MI (:,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'CROPRAINFEDFRAC') ,(/1,n/),(/NTILES,1/),MR (:,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGTYPE' ) ,(/1,n/),(/NTILES,1/),IRRIGTYPE (:,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGPLANT' ) ,(/1,1,n/),(/NTILES,1,1/), IRRIGPLANT (:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGPLANT' ) ,(/1,2,n/),(/NTILES,1,1/), IRRIGPLANT (:,2,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGHARVEST' ) ,(/1,1,n/),(/NTILES,1,1/), IRRIGHARVEST(:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGHARVEST' ) ,(/1,2,n/),(/NTILES,1,1/), IRRIGHARVEST(:,2,n)) ; VERIFY_(STATUS) + + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDPLANT' ) ,(/1,1,n/),(/NTILES,1,1/), RAINFEDPLANT (:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDPLANT' ) ,(/1,2,n/),(/NTILES,1,1/), RAINFEDPLANT (:,2,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDHARVEST' ) ,(/1,1,n/),(/NTILES,1,1/), RAINFEDHARVEST(:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDHARVEST' ) ,(/1,2,n/),(/NTILES,1,1/), RAINFEDHARVEST(:,2,n)) ; VERIFY_(STATUS) + end do + + status = NF_CLOSE(NCOutID) + + END SUBROUTINE MergeData + + !---------------------------------------------------------------------------------------- + + SUBROUTINE ReadProcess_IMethod (NTILES, f_sprink, f_drip, f_flood) + + implicit none + + integer, INTENT (IN) :: NTILES + real, dimension (:), INTENT(INOUT) :: f_sprink, f_drip, f_flood + integer :: i,j,n, k, N_METHOD, cnt_code, st_code + character*2 :: ST_NAME + character*3 :: CNT_ABR + integer, parameter :: N_STATES = 50, N_COUNTRY = 256 + real :: s_dum, d_dum, f_dum + real, dimension (:), allocatable :: us_sprink, us_drip, us_flood, us_tarea + real, dimension (:), allocatable :: sprink, drip, flood, tarea + integer, dimension (:),pointer :: index_range + character*2, dimension (:),pointer :: ST_NAME_ABR + character*3, dimension (:),pointer :: CNT_NAME_ABR + + ! Read state fractions + print *, ' ' + print *, '.........................................................................' + print *, 'PROCESSING IRRIGATION METHOD DATA ' + + open (10, file = 'data/CATCH/IRRIGATION/US_IMethod.2015' , form = 'formatted', status ='old', action = 'read') + open (11, file = 'data/CATCH/IRRIGATION/Global_IMethod.data', form = 'formatted', status ='old', action = 'read') + + READ (11, *) N_METHOD + + call get_country_codes (index_range=index_range, ST_NAME_ABR = ST_NAME_ABR, CNT_NAME_ABR = CNT_NAME_ABR) + + allocate (sprink (0:N_COUNTRY)) + allocate (drip (0:N_COUNTRY)) + allocate (flood (0:N_COUNTRY)) + allocate (tarea (0:N_COUNTRY)) + allocate (us_sprink(1:N_STATES )) + allocate (us_drip (1:N_STATES )) + allocate (us_flood (1:N_STATES )) + allocate (us_tarea (1:N_STATES )) + + sprink = 0. + drip = 0. + flood = 0. + tarea = 0. + us_sprink = 0. + us_drip = 0. + us_flood = 0. + us_tarea = 0. + + do i = 1, N_METHOD + read (11, *) CNT_ABR,s_dum, d_dum, f_dum + do k = 1, N_COUNTRY + if(CNT_ABR == CNT_NAME_ABR(k)) then + sprink(index_range(k)) = s_dum + drip (index_range(k)) = d_dum + flood (index_range(k)) = f_dum + endif + end do + end do + + tarea = sprink + drip + flood + where (tarea > 0.) + sprink = sprink / tarea + drip = drip / tarea + flood = flood / tarea + endwhere + + do i = 1, N_STATES + read (10, *) ST_NAME,s_dum, d_dum, f_dum + do k = 1, N_STATES + if(ST_NAME == ST_NAME_ABR(k)) then + us_sprink(k) = s_dum + us_drip (k) = d_dum + us_flood (k) = f_dum + endif + end do + end do + + us_tarea = us_sprink + us_drip + us_flood + where (us_tarea > 0.) + us_sprink = us_sprink / us_tarea + us_drip = us_drip / us_tarea + us_flood = us_flood / us_tarea + endwhere + + close (10, status = 'keep') + close (11, status = 'keep') + + ! map irrig method fractions + + open (10,file='clsm/country_and_state_code.data', & + form='formatted',status='old', action = 'read') + + ! allocate and initialize + + f_flood = 1. + f_sprink = 0. + f_drip = 0. + + tile_loop : do n = 1, NTILES + read (10, '(i8, 2I4)') j, cnt_code, st_code + if (cnt_code < 257) then + if(tarea (cnt_code) > 0.) then + f_flood (n) = flood (cnt_code) + f_sprink(n) = sprink(cnt_code) + f_drip (n) = drip (cnt_code) + endif + endif + + ! overwrite with US state methods + if(st_code /= 999) then + f_flood (n) = us_flood (st_code) + f_sprink(n) = us_sprink(st_code) + f_drip (n) = us_drip (st_code) + endif + end do tile_loop + + close (10, status = 'keep') + + CALL update_IMethod_bycounty (NTILES, f_sprink, f_drip, f_flood) + + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'SPRINKLERFR') ,(/1/),(/NTILES/), f_sprink) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'DRIPFR' ) ,(/1/),(/NTILES/), f_drip ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'FLOODFR' ) ,(/1/),(/NTILES/), f_flood ) ; VERIFY_(STATUS) + + deallocate (us_sprink, us_drip, us_flood, us_tarea, sprink, drip, flood, tarea) + + END SUBROUTINE ReadProcess_IMethod + + !---------------------------------------------------------------------------------------- + + SUBROUTINE update_IMethod_bycounty (NTILES, f_sprink, f_drip, f_flood) + + implicit none + integer, INTENT (IN) :: NTILES + real, dimension (:), INTENT(INOUT) :: f_sprink, f_drip, f_flood + integer, parameter :: NX_cb = 43200, NY_cb = 21600, NY_cbData = 10800 + integer, parameter :: cb_states = 72, cb_county = 900, cb_countyUS = 3220 + integer :: i,j, n, status, ncid, I0(1), j0(1),SS, CCC + real, dimension(:,:),allocatable :: SFR, DFR, FFR + integer, dimension (:),allocatable :: GEOID + integer, dimension(:,:),allocatable :: POLYID + real (kind =8) :: XG(NX_cb),YG(NY_cb), y0, x0, dxy + integer :: ii(NX_cb),jj(NY_cb) + + allocate (SFR (1:cb_county,1:cb_states)) + allocate (DFR (1:cb_county,1:cb_states)) + allocate (FFR (1:cb_county,1:cb_states)) + allocate (GEOID (1:cb_countyUS)) + allocate (POLYID(1:NX_cb,1:NY_cb)) + + POLYID = -9999 + + status = NF_OPEN ('data/CATCH/IRRIGATION/cb_2015_us_county_30arcsec.nc4',NF_NOWRITE, ncid) ; VERIFY_(STATUS) + do j = 1, NY_cbData + status = NF_GET_VARA_INT(NCID,VarID(NCID,'POLYID') ,(/1,j/),(/NX_cb, 1/), POLYID (:,NY_cb - j + 1)) ; VERIFY_(STATUS) ! reading north to south + end do + do j = 1, cb_states + status = NF_GET_VARA_REAL(NCID,VarID(NCID,'SPRINKLERFR') ,(/1,j/),(/cb_county, 1/), SFR (:,j)) ; VERIFY_(STATUS) + status = NF_GET_VARA_REAL(NCID,VarID(NCID,'DRIPFR' ) ,(/1,j/),(/cb_county, 1/), DFR (:,j)) ; VERIFY_(STATUS) + status = NF_GET_VARA_REAL(NCID,VarID(NCID,'FLOODFR' ) ,(/1,j/),(/cb_county, 1/), FFR (:,j)) ; VERIFY_(STATUS) + end do + status = NF_GET_VARA_INT(NCID,VarID(NCID,'GEOID' ) ,(/1/),(/cb_countyUS/), GEOID) ; VERIFY_(STATUS) + status = NF_CLOSE(NCID) ; VERIFY_(STATUS) + + dxy = 360.d0/NX_cb + do i = 1, NX_cb + xg(i) = (i-1)*dxy -180.d0 + dxy/2.d0 + end do + do i = 1, NY_cb + yg(i) = (i-1)*dxy -90.d0 + dxy/2.d0 + end do + + do n = 1, NTILES + + x0 = dble (tile_lon(n)) + y0 = dble (tile_lat(n)) + II = 0 + JJ = 0 + WHERE ((xg >= x0).and.(xg < x0 + dxy)) II = 1 + WHERE ((yg >= y0).and.(yg < y0 + dxy)) JJ = 1 + + I0 = FINDLOC(II,1) + J0 = FINDLOC(JJ,1) + + if((POLYID(I0(1), J0(1)) >= 1).AND.(POLYID(I0(1), J0(1)) <= cb_countyUS)) then + SS = GEOID(POLYID(I0(1),J0(1))) / 1000 + CCC= GEOID(POLYID(I0(1),J0(1))) - SS*1000 + f_sprink (n) = SFR (CCC,SS) + f_drip (n) = DFR (CCC,SS) + f_flood (n) = FFR (CCC,SS) + endif + + END DO + + deallocate (SFR, DFR, FFR, GEOID, POLYID) + + END SUBROUTINE update_IMethod_bycounty + + !---------------------------------------------------------------------------------------- + + SUBROUTINE ReadProcess_MIRCA (NC, NR, NTILES, tile_id, MIFRAC, MRFRAC) + + implicit none + + INTEGER, INTENT (IN) :: NTILES, NC, NR + INTEGER, INTENT (IN), DIMENSION(:,:):: tile_id + REAL,DIMENSION(:,:,:),INTENT(INOUT) :: MIFRAC, MRFRAC + character*2 :: TT + integer :: i, j, n, m + real,dimension (:), allocatable :: read_ir , read_rn, cnt_pix1, cnt_pix2 + real,dimension (:,:,:), allocatable :: mon_ir , mon_rn + real, pointer, dimension (:,:) :: var_raster1, var_raster2 + real,parameter :: radius = MAPL_radius, pi = MAPL_PI + real :: D2R, latc, lonc, area + + ! --------- VARIABLES FOR *OPENMP* PARALLEL ENVIRONMENT ------------ + ! + ! NOTE: "!$" is for conditional compilation + ! + logical :: running_omp = .false. + ! + !$ integer :: omp_get_thread_num, omp_get_num_threads + ! + integer :: n_threads=1, li, ui, t_count, n_used + ! + integer, dimension(:), allocatable :: low_ind, upp_ind + ! + ! ------------------------------------------------------------------ + + ! ----------- OpenMP PARALLEL ENVIRONMENT ---------------------------- + ! + ! FIND OUT WHETHER -omp FLAG HAS BEEN SET DURING COMPILATION + ! + !$ running_omp = .true. ! conditional compilation + ! + ! ECHO BASIC OMP VARIABLES + ! + !$OMP PARALLEL DEFAULT(NONE) SHARED(running_omp,n_threads) + ! + !$OMP SINGLE + ! + !$ n_threads = omp_get_num_threads() + ! + !$ write (*,*) 'running_omp = ', running_omp + !$ write (*,*) + !$ write (*,*) 'parallel OpenMP with ', n_threads, 'threads' + !$ write (*,*) + !$OMP ENDSINGLE + ! + !$OMP CRITICAL + !$ write (*,*) 'thread ', omp_get_thread_num(), ' alive' + !$OMP ENDCRITICAL + ! + !$OMP BARRIER + ! + !$OMP ENDPARALLEL + + MIFRAC = 0. + MRFRAC = 0. + + n_used = MIN(n_threads, NCROPS/2) + if(NTILES > 6000000) n_used = 1 ! otherwise multiple threads will run out of virtual memory + allocate(low_ind(n_used)) + allocate(upp_ind(n_used)) + low_ind(1) = 1 + upp_ind(n_used) = NCROPS + + if (running_omp) then + do i=1,n_used-1 + upp_ind(i) = low_ind(i) + (NCROPS/n_used) - 1 + low_ind(i+1) = upp_ind(i) + 1 + end do + end if + + D2R= PI/180. + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP COPYIN (read_ir, read_rn,var_raster1, var_raster2, mon_ir, mon_rn, cnt_pix1, cnt_pix2) & + !$OMP SHARED( n_used, low_ind, upp_ind, tile_id, NTILES, MIFRAC,MRFRAC, NC, NR, D2R) & + !$OMP PRIVATE(n,i,j,m,tt,t_count, read_ir, read_rn,var_raster1, var_raster2, mon_ir, mon_rn, cnt_pix1, cnt_pix2, latc, area) + + allocate (read_ir (1:NX_mirca*12)) + allocate (read_rn (1:NX_mirca*12)) + allocate (mon_ir (1:NX_mirca,1:NY_mirca,1:12)) + allocate (mon_rn (1:NX_mirca,1:NY_mirca,1:12)) + allocate (var_raster1 (1:nc,1:nr)) + allocate (var_raster2 (1:nc,1:nr)) + allocate (cnt_pix1 (1:NTILES)) + allocate (cnt_pix2 (1:NTILES)) + + !$OMP DO + + DO t_count = 1,n_used + + CROP_TYPE : DO n = low_ind(t_count),upp_ind(t_count) + + write (tt, '(i2.2)') n + + print *, ' ' + print *, '.........................................................................' + print *, 'PROCESSING MIRCA : crop_', tt,'_irrigated_12.flt' + print *, 'PROCESSING MIRCA : crop_', tt,'_rainfed_12.flt' + + mon_ir = UNDEF + mon_rn = UNDEF + + open (50 + t_count, file = trim(MIRCA_path)//tt//'_irrigated_12.flt', action = 'read', & + form = 'unformatted', access='direct', recl=NX_mirca*12) + open (100 + t_count, file = trim(MIRCA_path)//tt//'_rainfed_12.flt', action = 'read', & + form = 'unformatted', access='direct', recl=NX_mirca*12) + + mirca_rows : do j = 1, NY_mirca + read(50 + t_count,rec= NY_mirca - J + 1) read_ir + read(100 + t_count,rec= NY_mirca - J + 1) read_rn + latc = lat1_mirca - (j-1) * DXY_MIRCA + area = (sin(d2r*(latc+0.5*dxy_mirca)) - sin(d2r*(latc-0.5*dxy_mirca)))*(dxy_mirca*d2r) + area = area * radius * radius / 10000. ! in ha + + mirca_COLS : do i = 1, NX_MIRCA + mon_ir (i,j,:) = read_ir ((i-1)*12 + 1: (i-1)*12 + 12)/area + mon_rn (i,j,:) = read_rn ((i-1)*12 + 1: (i-1)*12 + 12)/area + end do mirca_cols + + end do mirca_rows + + close (50 + t_count, status ='keep') + close (100 + t_count, status ='keep') + + ! Grid 2 tile + ! ----------- + do m = 1,12 + + var_raster1 = 0. + var_raster2 = 0. + + call RegridRasterReal(mon_ir(:,:,m),var_raster1) + call RegridRasterReal(mon_rn(:,:,m),var_raster2) + + cnt_pix1 = 0. + cnt_pix2 = 0. + + do j = 1,nr + do i = 1,nc + if((var_raster1 (i,j) > 0.).and.(tile_id (i,j) >= 1).AND.(tile_id (i,j) <= NTILES)) then + MIFRAC (tile_id(i,j),m,n) = MIFRAC (tile_id(i,j),m,n) + var_raster1 (i,j) + cnt_pix1 (tile_id(i,j)) = cnt_pix1 (tile_id(i,j)) + 1. + endif + if((var_raster2 (i,j) > 0.).and.(tile_id (i,j) >= 1).AND.(tile_id (i,j) <= NTILES)) then + MRFRAC (tile_id(i,j),m,n) = MRFRAC (tile_id(i,j),m,n) + var_raster2 (i,j) + cnt_pix2 (tile_id(i,j)) = cnt_pix2 (tile_id(i,j)) + 1. + endif + end do + end do + + do i = 1, NTILES + if(cnt_pix1(i) > 0.) MIFRAC (i,m,n) = MIFRAC (i,m,n)/cnt_pix1(i) + if(cnt_pix2(i) > 0.) MRFRAC (i,m,n) = MRFRAC (i,m,n)/cnt_pix2(i) + end do + + end do + END DO CROP_TYPE + END DO + !$OMP END DO + !$OMP END PARALLEL + + print *,'DONE MIRCA PROCESSING' + END SUBROUTINE ReadProcess_MIRCA + + !---------------------------------------------------------------------------------------- + + SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NGRIPC) + + INTEGER, INTENT (IN) :: NTILES, NC, NR + INTEGER, INTENT (IN), DIMENSION(:,:):: tile_id + REAL,DIMENSION(:),INTENT(INOUT) :: IGRIPC, RGRIPC, PGRIPC, NGRIPC + real, allocatable :: var_in (:,:), tot_cnt (:), min_cnt(:), max_cnt(:) + integer :: i,j, n, r, status, DOY, NCID, NCIDW,xid, yid,vid + integer, pointer :: iraster (:,:) + character*3 :: DDD + integer*2, allocatable, dimension (:,:) :: Lai_clim + real, allocatable, dimension (:,:) :: clim_min, clim_max, clim_lai + real, allocatable, dimension (:) :: LAI_MIN, LAI_MAX + logical :: write_lai = .false. + + + if (write_lai) then + + ! Process LAI first + ! ----------------- + + status = NF_CREATE ('data/CATCH/IRRIGATION/MCD15A2H.006_LAI_climMinMax.nc4' , NF_NETCDF4, NCIDW) ; VERIFY_(STATUS) + status = NF_DEF_DIM(NCIDW, 'lon' , NX_LAI, xid) ; VERIFY_(STATUS) + status = NF_DEF_DIM(NCIDW, 'lat' , NY_LAI, yid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCIDW, 'LAIMIN' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCIDW, 'LAIMAX' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) + status = NF_ENDDEF(NCIDW) + + allocate (Lai_clim (1:NX_LAI, 1: NY_LAI)) + allocate (clim_min (1:NX_LAI, 1: NY_LAI)) + allocate (clim_max (1:NX_LAI, 1: NY_LAI)) + allocate (clim_lai (1:NX_LAI, 1: NY_LAI)) + clim_max = -9999. + clim_min = 9999. + + DO DOY = 1, 361, 8 + write (DDD, '(i3.3)') DOY + print *,trim(LAI_file)//DDD//'.nc4' + status = NF_OPEN(trim(LAI_file)//DDD//'.nc4',NF_NOWRITE, ncid); VERIFY_(STATUS) + STATUS = NF_GET_VARA_INT2 (NCID,VarID(NCID,'Lai_500m'),(/1,1/),(/NX_LAI,NY_LAI/),Lai_clim) ; VERIFY_(STATUS) + + clim_lai = -9999. + where ((Lai_clim >=0).and.(Lai_clim <= 100)) + clim_lai = lai_clim * 0.1 + end where + where ((clim_lai >= 0.) .and. (clim_lai > clim_max)) + clim_max = clim_lai + end where + where ((clim_lai >= 0.) .and. (clim_lai < clim_min)) + clim_min = clim_lai + end where + STATUS = NF_CLOSE (NCID) + END DO + + STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) + STATUS = NF_CLOSE (NCIDW) + deallocate (lai_clim, clim_lai, clim_min, clim_max) + endif + + allocate( var_in(NX_gripc,NY_gripc)) + var_in = UNDEF + + open ( 10, file = trim(GRIPC_file), form = 'unformatted', access='direct', recl=(NX_gripc)) + + !- Read input file:: + + do j = 1, NY_gripcdata + r = NY_gripc -j + 1 + read(10,rec=j) var_in(:, r) + do i = 1, NX_gripc + if( var_in(i, r) == 0. ) var_in(i, r) = -9999. + if( var_in(i, r) == 4. ) var_in(i, r) = -9999. + end do + end do + close( 10 ) + + allocate(iraster(NX_gripc,NY_gripc),stat=STATUS); VERIFY_(STATUS) + call RegridRaster(tile_id,iraster) + + allocate (tot_cnt (1:ntiles)) + allocate (min_cnt (1:ntiles)) + allocate (max_cnt (1:ntiles)) + + RGRIPC = 0. + IGRIPC = 0. + PGRIPC = 0. + tot_cnt = 0. + min_cnt = 0. + max_cnt = 0. + allocate (LAI_MIN (NTILES)) + allocate (LAI_MAX (NTILES)) + LAI_MIN = -9999. + LAI_MAX = -9999. + + ! Read Min/Max LAI + allocate (clim_min (1:NX_LAI, 1: NY_LAI)) + allocate (clim_max (1:NX_LAI, 1: NY_LAI)) + status = NF_OPEN('data/CATCH/IRRIGATION/MCD15A2H.006_LAI_climMinMax.nc4', NF_NOWRITE, NCIDW); VERIFY_(STATUS) + STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) + STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) + STATUS = NF_CLOSE (NCIDW) + + do j = 1,NY_gripc + do i = 1,NX_gripc + if((iraster (i,j) >=1).and.(iraster (i,j) <=ntiles)) then + tot_cnt (iraster (i,j)) = tot_cnt (iraster (i,j)) + 1. + if (var_in(i,j) == 1) RGRIPC(iraster (i,j)) = RGRIPC(iraster (i,j)) + 1. + if (var_in(i,j) == 2) IGRIPC(iraster (i,j)) = IGRIPC(iraster (i,j)) + 1. + if (var_in(i,j) == 3) PGRIPC(iraster (i,j)) = PGRIPC(iraster (i,j)) + 1. + if (var_in(i,j) == 4) NGRIPC(iraster (i,j)) = NGRIPC(iraster (i,j)) + 1. + + if(var_in(i,j) == 2) then + if(clim_min(i,j) < 10.) then + if(LAI_MIN(iraster (i,j)) < 0.) LAI_MIN(iraster (i,j)) = 0. + LAI_MIN (iraster (i,j)) = LAI_MIN (iraster (i,j)) + clim_min(i,j) + min_cnt (iraster (i,j)) = min_cnt (iraster (i,j)) + 1. + endif + + if(clim_max(i,j) >= 0.) then + if(LAI_MAX(iraster (i,j)) < 0.) LAI_MAX(iraster (i,j)) = 0. + LAI_MAX (iraster (i,j)) = LAI_MAX (iraster (i,j)) + clim_max(i,j) + max_cnt (iraster (i,j)) = max_cnt (iraster (i,j)) + 1. + endif + endif + endif + end do + end do + + RGRIPC = RGRIPC / tot_cnt + IGRIPC = IGRIPC / tot_cnt + PGRIPC = PGRIPC / tot_cnt + NGRIPC = NGRIPC / tot_cnt + + where (max_cnt > 0.) LAI_MAX = LAI_MAX / max_cnt + where (min_cnt > 0.) LAI_MIN = LAI_MIN / min_cnt + + ! Fill LAI gaps + ! ------------- + ! print *, 'START LAI gap filling',COUNT(LAI_MAX >=0.), MAXVAL(LAI_MAX),count (IGRIPC > 0.) + DO I = 1, NTILES + IF((IGRIPC (I) > 0.) .AND. (LAI_MAX(I) < 0.)) THEN + j = getNeighbor (I,lai_in=LAI_MAX) + LAI_MIN (I) = LAI_MIN (j) + LAI_MAX (I) = LAI_MAX (j) + ENDIF + END DO + + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'LAIMAX' ) ,(/1/),(/NTILES/),LAI_MAX ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'LAIMIN' ) ,(/1/),(/NTILES/),LAI_MIN ) ; VERIFY_(STATUS) + + deallocate (var_in, iraster, clim_min, clim_max, min_cnt, max_cnt, tot_cnt, LAI_MIN, LAI_MAX) + + print *,'DONE PROCESSING GRIPC and MCD15A2H LAI' + + END SUBROUTINE ReadProcess_GRIPC + + ! ---------------------------------------------------------------------- + + SUBROUTINE ReadProcess_GIA (NC, NR, NTILES, tile_id, GIAFRAC) + + implicit none + + INTEGER, INTENT (IN) :: NTILES, NC, NR + INTEGER, INTENT (IN), DIMENSION(:,:):: tile_id + REAL,DIMENSION(NTILES),INTENT(INOUT) :: GIAFRAC + + integer, allocatable, dimension (:,:) :: var_in + integer, allocatable, dimension (:,:) :: irrig + real,dimension (:), allocatable :: cnt_pix1 + integer :: i,j, status, NCID + + ! Read GIA data + ! ------------- + + allocate( var_in(NX_GIA,NY_GIA)) + var_in = UNDEF + + print *, 'PROCESSING GIA : ', trim (GIA_file) + status = NF_OPEN (trim(GIA_file),NF_NOWRITE, ncid) ; VERIFY_(STATUS) + + do j = NY_GIAData, 1, -1 + status = NF_GET_VARA_INT(NCID,VarID(NCID,'IrrigClass') ,(/1,j/),(/NX_GIA, 1/), var_in (:,j + 3600 )) ; VERIFY_(STATUS) + + end do + + status = NF_CLOSE(NCID) ; VERIFY_(STATUS) + allocate (irrig (1:NC, 1:NR)) + irrig = undef + + if (NC /= NX_GIA) then + call RegridRaster (var_in, irrig) + else + irrig = var_in + endif + + ! Compute Fractions on tiles + ! -------------------------- + + allocate (cnt_pix1 (NTILES)) + cnt_pix1 = 0. + GIAFRAC = 0. + + geos_rows : do j = 1, NR + geos_cols : do i = 1, NC + if ((tile_id(i,j) > 0).and.(tile_id (i,j) <= NTILES)) then + cnt_pix1(tile_id(i,j)) = cnt_pix1(tile_id(i,j)) + 1. + if((irrig (i,j) > 0) .AND. (irrig (i,j) < 4)) then + GIAFRAC(tile_id (i,j)) = GIAFRAC(tile_id (i,j)) + 1. + endif + endif + enddo geos_cols + end do geos_rows + where (cnt_pix1 > 0) GIAFRAC = GIAFRAC / cnt_pix1 + deallocate (irrig, var_in) + deallocate (cnt_pix1) + print *,'DONE PROCESSING GIA' + RETURN + END SUBROUTINE ReadProcess_GIA + + ! ---------------------------------------------------------------------- + + integer function VarID (NCFID, VNAME) + + integer, intent (in) :: NCFID + character(*), intent (in) :: VNAME + integer :: status + + STATUS = NF_INQ_VARID (NCFID, trim(VNAME) ,VarID) + IF (STATUS .NE. NF_NOERR) & + CALL HANDLE_ERR(STATUS, trim(VNAME)) + + end function VarID + + ! ----------------------------------------------------------------------- + + SUBROUTINE HANDLE_ERR(STATUS, Line) + + INTEGER, INTENT (IN) :: STATUS + CHARACTER(*), INTENT (IN) :: Line + + IF (STATUS .NE. NF_NOERR) THEN + PRINT *, trim(Line),': ',NF_STRERROR(STATUS) + STOP 'Stopped' + ENDIF + + END SUBROUTINE HANDLE_ERR + + ! ----------------------------------------------------------------------------- + + integer function getNeighbor (tid_in, lai_in, day_in) + + implicit none + integer, intent (in) :: tid_in + real, optional, dimension (NTILES) :: lai_in, day_in + integer :: i, nplus + logical :: tile_found + logical, allocatable, dimension (:) :: mask + integer, allocatable, dimension (:) :: sub_tid + real , allocatable, dimension (:) :: sub_lon, sub_lat, rev_dist + real :: dw, min_lon, max_lon, min_lat, max_lat + integer, allocatable, dimension (:) :: TILEID + + allocate (mask (1: NTILES)) + allocate (TILEID (1: NTILES)) + forall (i=1:NTILES) TILEID (i) = i + + dw = 0.5 + getNeighbor = -9999 + + ZOOMOUT : do + + tile_found = .false. + + ! Min/Max lon/lat of the working window + ! ------------------------------------- + + min_lon = MAX(tile_lon (tid_in) - dw, -180.) + max_lon = MIN(tile_lon (tid_in) + dw, 180.) + min_lat = MAX(tile_lat (tid_in) - dw, -90.) + max_lat = MIN(tile_lat (tid_in) + dw, 90.) + + mask = .false. + if(present (lai_in)) then + mask = ((tile_lat >= min_lat .and. tile_lat <= max_lat).and.(tile_lon >= min_lon .and. tile_lon <= max_lon).and.(lai_in >= 0.)) + endif + if(present (day_in)) then + mask = ((tile_lat >= min_lat .and. tile_lat <= max_lat).and.(tile_lon >= min_lon .and. tile_lon <= max_lon).and.(day_in < 998)) + endif + nplus = count(mask = mask) + + if(nplus < 0) then + dw = dw + 0.5 + CYCLE + endif + + allocate (sub_tid (1:nplus)) + allocate (sub_lon (1:nplus)) + allocate (sub_lat (1:nplus)) + allocate (rev_dist (1:nplus)) + + sub_tid = PACK (TILEID , mask= mask) + sub_lon = PACK (tile_lon, mask= mask) + sub_lat = PACK (tile_lat, mask= mask) + + ! compute distance from the tile + + sub_lat = sub_lat * MAPL_PI/180. + sub_lon = sub_lon * MAPL_PI/180. + + SEEK : if(getNeighbor < 0) then + + rev_dist = 1.e20 + + do i = 1,nplus + + rev_dist(i) = haversine(to_radian(tile_lat(tid_in)), to_radian(tile_lon(tid_in)), & + sub_lat(i), sub_lon(i)) + + end do + + FOUND : if(minval (rev_dist) < 1.e19) then + if(present (lai_in)) then + if(lai_in(sub_tid(minloc(rev_dist,1))) >= 0.) then + getNeighbor = sub_tid(minloc(rev_dist,1)) + tile_found = .true. + endif + endif + if(present (day_in)) then + if(day_in(sub_tid(minloc(rev_dist,1))) < 998) then + getNeighbor = sub_tid(minloc(rev_dist,1)) + tile_found = .true. + endif + endif + endif FOUND + + endif SEEK + + deallocate (sub_tid, sub_lon, sub_lat, rev_dist) + + if(tile_found) GO TO 100 + + ! if not increase the window size + dw = dw + 0.5 + + end do ZOOMOUT + +100 continue + + deallocate (mask) + + end function getNeighbor + + ! ***************************************************************************** + + function to_radian(degree) result(rad) + + real,intent(in) :: degree + real :: rad + + rad = degree*MAPL_PI/180. + + end function to_radian + + ! ***************************************************************************** + + real function haversine(deglat1,deglon1,deglat2,deglon2) + ! great circle distance -- adapted from Matlab + real,intent(in) :: deglat1,deglon1,deglat2,deglon2 + real :: a,c, dlat,dlon,lat1,lat2 + real,parameter :: radius = MAPL_radius + + ! dlat = to_radian(deglat2-deglat1) + ! dlon = to_radian(deglon2-deglon1) + ! lat1 = to_radian(deglat1) + ! lat2 = to_radian(deglat2) + dlat = deglat2-deglat1 + dlon = deglon2-deglon1 + lat1 = deglat1 + lat2 = deglat2 + a = (sin(dlat/2))**2 + cos(lat1)*cos(lat2)*(sin(dlon/2))**2 + if(a>=0. .and. a<=1.) then + c = 2*atan2(sqrt(a),sqrt(1-a)) + haversine = radius*c / 1000. + else + haversine = 1.e20 + endif + end function + + ! ***************************************************************************** + end subroutine create_irrig_params + + END module module_irrig_params + +! ----------------------------------------------------------------------------- + +!PROGRAM irrig_model +! +! use module_irrig_params +! +! call create_irrig_params (43200, 21600, 'rst/SMAP_EASEv2_M36_964x406') +! +!END PROGRAM irrig_model From 85e6e0bb44511d41dba9354a946dfdea8888033f Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 24 Apr 2024 11:53:36 -0700 Subject: [PATCH 09/55] restored commented-out code related to irrigation --- .../Utils/Raster/makebcs/mkCatchParam.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index 83e58fce8..f5830a61d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -21,7 +21,7 @@ PROGRAM mkCatchParam use EASE_conv use rmTinyCatchParaMod use process_hres_data - ! use module_irrig_params, ONLY : create_irrig_params + use module_irrig_params, ONLY : create_irrig_params implicit none @@ -674,9 +674,9 @@ PROGRAM mkCatchParam write (log_file,'(a)')' ' endif - ! inquire(file='clsm/irrig.dat', exist=file_exists) - ! if (.not.file_exists) call create_irrig_params (nc,nr,fnameRst) - ! write (log_file,'(a)')'Done computing irrigation model parameters ...............13' + inquire(file='clsm/irrig.dat', exist=file_exists) + if (.not.file_exists) call create_irrig_params (nc,nr,fnameRst) + write (log_file,'(a)')'Done computing irrigation model parameters ...............13' write (log_file,'(a)')'============================================================' write (log_file,'(a)')'DONE creating CLSM data files...............................' From 7fbfa8a035675501e4ae4ae56781dc546b40acc7 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 24 Apr 2024 12:28:33 -0700 Subject: [PATCH 10/55] fixed typo --- .../GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index f5830a61d..cb02ed860 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -677,7 +677,7 @@ PROGRAM mkCatchParam inquire(file='clsm/irrig.dat', exist=file_exists) if (.not.file_exists) call create_irrig_params (nc,nr,fnameRst) write (log_file,'(a)')'Done computing irrigation model parameters ...............13' - + endif write (log_file,'(a)')'============================================================' write (log_file,'(a)')'DONE creating CLSM data files...............................' write (log_file,'(a)')'============================================================' From a253da24e144bc57a8c456e21feb736aef1483c9 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 24 Apr 2024 16:14:26 -0700 Subject: [PATCH 11/55] Revert "fixed typo" This reverts commit 7fbfa8a035675501e4ae4ae56781dc546b40acc7. --- .../GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index cb02ed860..f5830a61d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -677,7 +677,7 @@ PROGRAM mkCatchParam inquire(file='clsm/irrig.dat', exist=file_exists) if (.not.file_exists) call create_irrig_params (nc,nr,fnameRst) write (log_file,'(a)')'Done computing irrigation model parameters ...............13' - endif + write (log_file,'(a)')'============================================================' write (log_file,'(a)')'DONE creating CLSM data files...............................' write (log_file,'(a)')'============================================================' From 36aee029e448c94f3db75a8c42dc491dcdbd08ad Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 24 Apr 2024 16:15:09 -0700 Subject: [PATCH 12/55] Revert "restored commented-out code related to irrigation" This reverts commit 85e6e0bb44511d41dba9354a946dfdea8888033f. --- .../Utils/Raster/makebcs/mkCatchParam.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index f5830a61d..83e58fce8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -21,7 +21,7 @@ PROGRAM mkCatchParam use EASE_conv use rmTinyCatchParaMod use process_hres_data - use module_irrig_params, ONLY : create_irrig_params + ! use module_irrig_params, ONLY : create_irrig_params implicit none @@ -674,9 +674,9 @@ PROGRAM mkCatchParam write (log_file,'(a)')' ' endif - inquire(file='clsm/irrig.dat', exist=file_exists) - if (.not.file_exists) call create_irrig_params (nc,nr,fnameRst) - write (log_file,'(a)')'Done computing irrigation model parameters ...............13' + ! inquire(file='clsm/irrig.dat', exist=file_exists) + ! if (.not.file_exists) call create_irrig_params (nc,nr,fnameRst) + ! write (log_file,'(a)')'Done computing irrigation model parameters ...............13' write (log_file,'(a)')'============================================================' write (log_file,'(a)')'DONE creating CLSM data files...............................' From f10d5af9109065c4e0e473cfdf657718d9ce8905 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 29 May 2024 15:03:30 -0700 Subject: [PATCH 13/55] fixed Irrigation bcs --- .../Utils/Raster/makebcs/CMakeLists.txt | 1 + .../Raster/makebcs/make_bcs_questionary.py | 1 + .../Utils/Raster/makebcs/make_bcs_shared.py | 2 +- .../Utils/Raster/makebcs/mkCatchParam.F90 | 16 ++++++--- .../Raster/makebcs/module_irrig_params.F90 | 36 ++++++++++--------- .../Raster/makebcs/rmTinyCatchParaMod.F90 | 12 +++++++ 6 files changed, 46 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt index 7a29c9a6f..ab4d168c3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt @@ -8,6 +8,7 @@ rasterize.F90 read_riveroutlet.F90 CubedSphere_GridMod.F90 rmTinyCatchParaMod.F90 +module_irrig_params.F90 zip.c util.c ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py index 0baa3b320..42da817e3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py @@ -194,6 +194,7 @@ def ask_questions(default_grid="Cubed-Sphere"): "v09 : NL3 + PEATMAP + MODIS snow alb", \ "v10 : NL3 + PEATMAP + MODIS snow alb v2", \ "v11 : NL3 + JPL veg height + PEATMAP + MODIS snow alb v2", \ + "v12 : NL3 + JPL veg height + PEATMAP + MODIS snow alb v2 + Irrigation", \ "ICA : Icarus (archived*: /discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Icarus/)", \ "GM4 : Ganymed-4_0 (archived*: /discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Ganymed-4_0/)", \ "F25 : Fortuna-2_5 (archived*: n/a)"], diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_shared.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_shared.py index a32f0f27b..1e37d69c4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_shared.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_shared.py @@ -15,7 +15,7 @@ def get_script_head() : #SBATCH --time=12:00:00 #SBATCH --nodes=1 #SBATCH --job-name={GRIDNAME2}.j -#SBATCH --constraint=sky|cas +#SBATCH --constraint=sky|cas|mil echo "-----------------------------" echo "make_bcs starts date/time" diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index 83e58fce8..c62730a88 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -21,7 +21,7 @@ PROGRAM mkCatchParam use EASE_conv use rmTinyCatchParaMod use process_hres_data - ! use module_irrig_params, ONLY : create_irrig_params + use module_irrig_params, ONLY : create_irrig_params implicit none @@ -673,10 +673,18 @@ PROGRAM mkCatchParam write (log_file,'(a)')' Done.' write (log_file,'(a)')' ' endif + + if(IRRIGBCS) then + tmpstring = 'Step 15: Irrigation' + inquire(file='clsm/irrig.dat', exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)') trim(tmpstring) + write (log_file,'(a)')' Creating file...' + call create_irrig_params (nc,nr,fnameRst) + write (log_file,'(a)') ' Done computing irrigation model parameters...............' + endif - ! inquire(file='clsm/irrig.dat', exist=file_exists) - ! if (.not.file_exists) call create_irrig_params (nc,nr,fnameRst) - ! write (log_file,'(a)')'Done computing irrigation model parameters ...............13' + endif write (log_file,'(a)')'============================================================' write (log_file,'(a)')'DONE creating CLSM data files...............................' diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 index 0ac384e31..5ef758d1f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -30,7 +30,7 @@ subroutine create_irrig_params (nc, nr, gfile) integer, parameter :: NX_gripc = 86400 integer, parameter :: NY_gripc = 43200, NY_GripcData = 36000 - character*300, parameter :: GRIPC_file = 'data/CATCH/IRRIGATION/irrigtype_salmon2013.flt' + character*300, parameter :: GRIPC_file = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/crop_fraction_data/v1/irrigtype_salmon2013.flt' real, allocatable, dimension (:) :: IGRIPC, RGRIPC, PGRIPC, NGRIPC ! MIRCA2000 data @@ -42,7 +42,8 @@ subroutine create_irrig_params (nc, nr, gfile) real, parameter :: DXY_mirca= 360./REAL(NX_mirca) real, parameter :: lat1_mirca = 90.0 - DXY_mirca / 2.0 !1st grid center lat real, parameter :: lon1_mirca = -180.0 + DXY_mirca / 2.0 !1st grid center lon - character*300, parameter :: MIRCA_path = 'data/CATCH/IRRIGATION/crop_' + character*300, parameter :: MIRCA_pathIrr = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/crop_fraction_data/v1/irrigated/crop_' + character*300, parameter :: MIRCA_pathRain = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/crop_fraction_data/v1/rainfed/crop_' real, allocatable, dimension(:,:,:) :: MIFRAC, MRFRAC ! Global Irrigated Area data (GIA) @@ -50,7 +51,7 @@ subroutine create_irrig_params (nc, nr, gfile) integer, parameter :: NX_GIA = 43200 integer, parameter :: NY_GIA = 21600, NY_GIAData = 18000 - character*300, parameter :: GIA_file = 'data/CATCH/IRRIGATION/global_irrigated_areas.nc4' + character*300, parameter :: GIA_file = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/irrigation_class/v1/global_irrigated_areas.nc4' real, allocatable, dimension (:) :: GIAFRAC ! LAI data @@ -62,7 +63,7 @@ subroutine create_irrig_params (nc, nr, gfile) ! Irrigation Method ! ----------------- - character*300, parameter :: IM_path = 'data/CATCH/IRRIGATION/' + character*300, parameter :: IM_path = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/country_code_IMethod/v1/' ! Global/Local variables ! ---------------------- @@ -212,7 +213,7 @@ SUBROUTINE OpenFile status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'FIELDCAP' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'FIELDCAP' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('soil field capacity'), & 'soil field capacity') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 5,'m3/m3') ; VERIFY_(STATUS) @@ -345,11 +346,12 @@ SUBROUTINE OpenFile ! Put field capacity open (10,file='clsm/CLM4.5_abm_peatf_gdp_hdm_fc', & - form='formatted',status='old',action = 'read') + form='formatted',status='unknown',action = 'read') allocate (field_cap(1:NTILES)) - + do n = 1, NTILES - read (10,'(2I8, i3, f8.4, f8.2, f10.2, f8.4)' ) i, vid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(n) + read (10,'(2I10, i3, f8.4, f8.2, f10.2, f8.4)' ) i, vid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(n) + !read (10,'(2I8, i3, f8.4, f8.2, f10.2, f8.4)' ) i, vid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(n) end do status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'FIELDCAP' ) ,(/1/),(/NTILES/),field_cap ) ; VERIFY_(STATUS) @@ -906,8 +908,8 @@ SUBROUTINE ReadProcess_IMethod (NTILES, f_sprink, f_drip, f_flood) print *, '.........................................................................' print *, 'PROCESSING IRRIGATION METHOD DATA ' - open (10, file = 'data/CATCH/IRRIGATION/US_IMethod.2015' , form = 'formatted', status ='old', action = 'read') - open (11, file = 'data/CATCH/IRRIGATION/Global_IMethod.data', form = 'formatted', status ='old', action = 'read') + open (10, file = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/country_code_IMethod/v1/US_IMethod.2015' , form = 'formatted', status ='old', action = 'read') + open (11, file = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/country_code_IMethod/v1/Global_IMethod.data', form = 'formatted', status ='old', action = 'read') READ (11, *) N_METHOD @@ -1035,7 +1037,7 @@ SUBROUTINE update_IMethod_bycounty (NTILES, f_sprink, f_drip, f_flood) POLYID = -9999 - status = NF_OPEN ('data/CATCH/IRRIGATION/cb_2015_us_county_30arcsec.nc4',NF_NOWRITE, ncid) ; VERIFY_(STATUS) + status = NF_OPEN ('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/fraction_drip_flood_sprinkler/v1/cb_2015_us_county_30arcsec.nc4',NF_NOWRITE, ncid) ; VERIFY_(STATUS) do j = 1, NY_cbData status = NF_GET_VARA_INT(NCID,VarID(NCID,'POLYID') ,(/1,j/),(/NX_cb, 1/), POLYID (:,NY_cb - j + 1)) ; VERIFY_(STATUS) ! reading north to south end do @@ -1189,9 +1191,9 @@ SUBROUTINE ReadProcess_MIRCA (NC, NR, NTILES, tile_id, MIFRAC, MRFRAC) mon_ir = UNDEF mon_rn = UNDEF - open (50 + t_count, file = trim(MIRCA_path)//tt//'_irrigated_12.flt', action = 'read', & + open (50 + t_count, file = trim(MIRCA_pathIrr)//tt//'_irrigated_12.flt', action = 'read', & form = 'unformatted', access='direct', recl=NX_mirca*12) - open (100 + t_count, file = trim(MIRCA_path)//tt//'_rainfed_12.flt', action = 'read', & + open (100 + t_count, file = trim(MIRCA_pathRain)//tt//'_rainfed_12.flt', action = 'read', & form = 'unformatted', access='direct', recl=NX_mirca*12) mirca_rows : do j = 1, NY_mirca @@ -1273,7 +1275,7 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG ! Process LAI first ! ----------------- - status = NF_CREATE ('data/CATCH/IRRIGATION/MCD15A2H.006_LAI_climMinMax.nc4' , NF_NETCDF4, NCIDW) ; VERIFY_(STATUS) + status = NF_CREATE ('land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4' , NF_NETCDF4, NCIDW) ; VERIFY_(STATUS) status = NF_DEF_DIM(NCIDW, 'lon' , NX_LAI, xid) ; VERIFY_(STATUS) status = NF_DEF_DIM(NCIDW, 'lat' , NY_LAI, yid) ; VERIFY_(STATUS) status = NF_DEF_VAR(NCIDW, 'LAIMIN' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) @@ -1350,7 +1352,7 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG ! Read Min/Max LAI allocate (clim_min (1:NX_LAI, 1: NY_LAI)) allocate (clim_max (1:NX_LAI, 1: NY_LAI)) - status = NF_OPEN('data/CATCH/IRRIGATION/MCD15A2H.006_LAI_climMinMax.nc4', NF_NOWRITE, NCIDW); VERIFY_(STATUS) + status = NF_OPEN('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4', NF_NOWRITE, NCIDW); VERIFY_(STATUS) STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) STATUS = NF_CLOSE (NCIDW) @@ -1431,8 +1433,8 @@ SUBROUTINE ReadProcess_GIA (NC, NR, NTILES, tile_id, GIAFRAC) var_in = UNDEF print *, 'PROCESSING GIA : ', trim (GIA_file) - status = NF_OPEN (trim(GIA_file),NF_NOWRITE, ncid) ; VERIFY_(STATUS) - + status = NF_OPEN (trim (GIA_file),NF_NOWRITE, NCID) ; VERIFY_(STATUS) + do j = NY_GIAData, 1, -1 status = NF_GET_VARA_INT(NCID,VarID(NCID,'IrrigClass') ,(/1,j/),(/NX_GIA, 1/), var_in (:,j + 3600 )) ; VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 index d4f9436d9..38cd4884a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 @@ -48,6 +48,7 @@ module rmTinyCatchParaMod logical, public, save :: use_PEATMAP = .false. logical, public, save :: jpl_height = .false. + logical, public, save :: IRRIGBCS = .false. character*8, public, save :: LAIBCS = 'UNDEF' character*6, public, save :: SOILBCS = 'UNDEF' character*6, public, save :: MODALB = 'UNDEF' @@ -194,6 +195,17 @@ SUBROUTINE init_bcs_config (LBCSV) GNU = 1.0 use_PEATMAP = .true. jpl_height = .true. + + case ("v12") + LAIBCS = 'MODGEO' + SOILBCS = 'HWSD' + MODALB = 'MODIS2' + SNOWALB = 'MODC061v2' + GNU = 1.0 + use_PEATMAP = .true. + jpl_height = .true. + IRRIGBCS = .true. + case default print *,'init_bcs_config(): unknown land boundary conditions version (LBCSV)' From a6aca72dc0f43d3e06aa60326dbb99cb0aea4b14 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Fri, 7 Jun 2024 15:58:16 -0700 Subject: [PATCH 14/55] Fixed Irrigation Fractions and minor bugs --- .../GEOS_IrrigationGridComp.F90 | 15 ++++++++------- .../GEOSirrigation_GridComp/irrigation_model.F90 | 2 +- .../Utils/Raster/makebcs/mkCatchParam.F90 | 4 ++-- .../Utils/Raster/makebcs/module_irrig_params.F90 | 2 +- 4 files changed, 12 insertions(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index fca77febb..70bc3cba9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -564,13 +564,14 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! of the two fractions is the dominant surface type. where (IRRIGFRAC + PADDYFRAC > IM%IRRIG_THRES) - where (PADDYFRAC >= IRRIGFRAC) - PADDYFRAC = 1. - IRRIGFRAC = 0. - elsewhere - PADDYFRAC = 0. - IRRIGFRAC = 1. - endwhere +!To assign the entire cell to the largest fraction remove comments 568-574 + ! where (PADDYFRAC >= IRRIGFRAC) + ! PADDYFRAC = 1. + ! IRRIGFRAC = 0. + ! elsewhere + ! PADDYFRAC = 0. + ! IRRIGFRAC = 1. + ! endwhere elsewhere PADDYFRAC = 0. IRRIGFRAC = 0. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index cbb751e39..d305b47f5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -286,7 +286,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & END SELECT endif - ELSEIF (PADDYFRAC (N) > 0.) THEN + IF (PADDYFRAC (N) > 0.) THEN H1 = this%flood_stime H2 = this%flood_stime + this%flood_dur diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index c62730a88..7d15d9c0f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -679,9 +679,9 @@ PROGRAM mkCatchParam inquire(file='clsm/irrig.dat', exist=file_exists) if (.not.file_exists) then write (log_file,'(a)') trim(tmpstring) - write (log_file,'(a)')' Creating file...' + write (log_file,'(a)')' Creating file...' call create_irrig_params (nc,nr,fnameRst) - write (log_file,'(a)') ' Done computing irrigation model parameters...............' + write (log_file,'(a)') ' Done computing irrigation model parameters........' endif endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 index 5ef758d1f..aac19f299 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -984,7 +984,7 @@ SUBROUTINE ReadProcess_IMethod (NTILES, f_sprink, f_drip, f_flood) f_drip = 0. tile_loop : do n = 1, NTILES - read (10, '(i8, 2I4)') j, cnt_code, st_code + read (10, '(i10, 2I4)') j, cnt_code, st_code if (cnt_code < 257) then if(tarea (cnt_code) > 0.) then f_flood (n) = flood (cnt_code) From 01bb4f25641f9a64f13103f458b2801fd0369fdb Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 12 Jun 2024 14:36:43 -0700 Subject: [PATCH 15/55] fixed bugs irrigation --- .../irrigation_model.F90 | 100 +++++++++--------- .../Raster/makebcs/module_irrig_params.F90 | 3 +- 2 files changed, 53 insertions(+), 50 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index d305b47f5..4519160bb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -230,75 +230,77 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & CHECK_LAITHRES : IF (LAI(N) >= LAITHRES) THEN season_end = .false. - CHECK_IRRIGFRACS: IF (IRRIGFRAC(N) > 0.) THEN + CHECK_IRRIGFRACS: IF ((IRRIGFRAC(N) > 0.).OR.(PADDYFRAC(N)>0.)) THEN !----------------------------------------------------------------------------- ! Get the root zone moisture availability to the plant !----------------------------------------------------------------------------- - - if(SMREF(N) > SMWP(N))then - ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) - else - ma = -1. - endif + if (IRRIGFRAC(N) > 0.) then + if(SMREF(N) > SMWP(N))then + ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) + else + ma = -1. + endif - if(ma >= 0) then + if(ma >= 0) then - SELECT CASE (IRRIG_METHOD) - CASE (0) ! CONCURRENTLY SPRINKER + FLOOD + DRIP on corresponding fractions + SELECT CASE (IRRIG_METHOD) + CASE (0) ! CONCURRENTLY SPRINKER + FLOOD + DRIP on corresponding fractions - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - SRATE = SRATE (N,1), & - DRATE = DRATE (N,1), & - FRATE = FRATE (N,1)) + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + SRATE = SRATE (N,1), & + DRATE = DRATE (N,1), & + FRATE = FRATE (N,1)) - SRATE (N,1) = SRATE (N,1)*SPRINKLERFR(N) - DRATE (N,1) = DRATE (N,1)*DRIPFR (N) - FRATE (N,1) = FRATE (N,1)*FLOODFR (N) + SRATE (N,1) = SRATE (N,1)*SPRINKLERFR(N) + DRATE (N,1) = DRATE (N,1)*DRIPFR (N) + FRATE (N,1) = FRATE (N,1)*FLOODFR (N) - CASE (1) ! SPRINKLER only + CASE (1) ! SPRINKLER only - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - SRATE = SRATE (N,1)) + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + SRATE = SRATE (N,1)) - DRATE (N,1) = 0. - FRATE (N,1) = 0. + DRATE (N,1) = 0. + FRATE (N,1) = 0. - CASE (2) ! DRIP only + CASE (2) ! DRIP only - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - DRATE = DRATE (N,1)) + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + DRATE = DRATE (N,1)) - SRATE (N,1) = 0. - FRATE (N,1) = 0. + SRATE (N,1) = 0. + FRATE (N,1) = 0. - CASE (3) ! FLOOD only + CASE (3) ! FLOOD only - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - FRATE = FRATE (N,1)) + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + FRATE = FRATE (N,1)) - SRATE (N,1) = 0. - DRATE (N,1) = 0. + SRATE (N,1) = 0. + DRATE (N,1) = 0. - CASE DEFAULT - PRINT *, 'irrigrate_lai_trigger: IRRIG_METHOD can be 0,1,2, or3' - CALL EXIT(1) - END SELECT - endif - - IF (PADDYFRAC (N) > 0.) THEN - - H1 = this%flood_stime - H2 = this%flood_stime + this%flood_dur - if ((HC >= H1).AND.(HC < H2)) then - ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate for paddy. - if(H1 == HC) FRATE (N,2) = RZDEF(N) *0.1/(H2 - H1)/ 3600. - else - FRATE (N,2) = 0. + CASE DEFAULT + PRINT *, 'irrigrate_lai_trigger: IRRIG_METHOD can be 0,1,2, or3' + CALL EXIT(1) + END SELECT + endif endif - SRATE (N,2) = 0. - DRATE (N,2) = 0. + + if (PADDYFRAC (N) > 0.) then + H1 = this%flood_stime + H2 = this%flood_stime + this%flood_dur + if ((HC >= H1).AND.(HC < H2)) then + ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate for paddy. + if(H1 == HC) FRATE (N,2) = RZDEF(N) *0.1/(H2 - H1)/ 3600. + else + FRATE (N,2) = 0. + endif + SRATE (N,2) = 0. + DRATE (N,2) = 0. + endif + ELSE SRATE (N,:) = 0. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 index aac19f299..3a714440d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -351,7 +351,6 @@ SUBROUTINE OpenFile do n = 1, NTILES read (10,'(2I10, i3, f8.4, f8.2, f10.2, f8.4)' ) i, vid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(n) - !read (10,'(2I8, i3, f8.4, f8.2, f10.2, f8.4)' ) i, vid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(n) end do status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'FIELDCAP' ) ,(/1/),(/NTILES/),field_cap ) ; VERIFY_(STATUS) @@ -1009,6 +1008,8 @@ SUBROUTINE ReadProcess_IMethod (NTILES, f_sprink, f_drip, f_flood) status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'DRIPFR' ) ,(/1/),(/NTILES/), f_drip ) ; VERIFY_(STATUS) status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'FLOODFR' ) ,(/1/),(/NTILES/), f_flood ) ; VERIFY_(STATUS) + print *, 'DONE PROCESSING IRRIGATION METHOD DATA ' + deallocate (us_sprink, us_drip, us_flood, us_tarea, sprink, drip, flood, tarea) END SUBROUTINE ReadProcess_IMethod From 4de1127a211a0cb8d1730d5e0c947bb38f0c2fb7 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Tue, 25 Jun 2024 11:21:49 -0700 Subject: [PATCH 16/55] Updated calculation LAI thresholds necessary to trigger Irrigation --- .../Raster/makebcs/module_irrig_params.F90 | 157 ++++++++++-------- 1 file changed, 89 insertions(+), 68 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 index 3a714440d..3a4024d0e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -1267,53 +1267,53 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG character*3 :: DDD integer*2, allocatable, dimension (:,:) :: Lai_clim real, allocatable, dimension (:,:) :: clim_min, clim_max, clim_lai - real, allocatable, dimension (:) :: LAI_MIN, LAI_MAX + real, allocatable, dimension (:) :: LAI_MIN, LAI_MAX, lai + real,allocatable :: dum,yr,mn,dy,nt logical :: write_lai = .false. - - - if (write_lai) then + + ! if (write_lai) then ! Process LAI first ! ----------------- - status = NF_CREATE ('land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4' , NF_NETCDF4, NCIDW) ; VERIFY_(STATUS) - status = NF_DEF_DIM(NCIDW, 'lon' , NX_LAI, xid) ; VERIFY_(STATUS) - status = NF_DEF_DIM(NCIDW, 'lat' , NY_LAI, yid) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCIDW, 'LAIMIN' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCIDW, 'LAIMAX' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) - status = NF_ENDDEF(NCIDW) + ! status = NF_CREATE ('land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4' , NF_NETCDF4, NCIDW) ; VERIFY_(STATUS) + ! status = NF_DEF_DIM(NCIDW, 'lon' , NX_LAI, xid) ; VERIFY_(STATUS) + ! status = NF_DEF_DIM(NCIDW, 'lat' , NY_LAI, yid) ; VERIFY_(STATUS) + ! status = NF_DEF_VAR(NCIDW, 'LAIMIN' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) + ! status = NF_DEF_VAR(NCIDW, 'LAIMAX' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) + ! status = NF_ENDDEF(NCIDW) - allocate (Lai_clim (1:NX_LAI, 1: NY_LAI)) - allocate (clim_min (1:NX_LAI, 1: NY_LAI)) - allocate (clim_max (1:NX_LAI, 1: NY_LAI)) - allocate (clim_lai (1:NX_LAI, 1: NY_LAI)) - clim_max = -9999. - clim_min = 9999. + ! allocate (Lai_clim (1:NX_LAI, 1: NY_LAI)) + ! allocate (clim_min (1:NX_LAI, 1: NY_LAI)) + ! allocate (clim_max (1:NX_LAI, 1: NY_LAI)) + ! allocate (clim_lai (1:NX_LAI, 1: NY_LAI)) + ! clim_max = -9999. + ! clim_min = 9999. - DO DOY = 1, 361, 8 - write (DDD, '(i3.3)') DOY - print *,trim(LAI_file)//DDD//'.nc4' - status = NF_OPEN(trim(LAI_file)//DDD//'.nc4',NF_NOWRITE, ncid); VERIFY_(STATUS) - STATUS = NF_GET_VARA_INT2 (NCID,VarID(NCID,'Lai_500m'),(/1,1/),(/NX_LAI,NY_LAI/),Lai_clim) ; VERIFY_(STATUS) + ! DO DOY = 1, 361, 8 + ! write (DDD, '(i3.3)') DOY + ! print *,trim(LAI_file)//DDD//'.nc4' + ! status = NF_OPEN(trim(LAI_file)//DDD//'.nc4',NF_NOWRITE, ncid); VERIFY_(STATUS) + ! STATUS = NF_GET_VARA_INT2 (NCID,VarID(NCID,'Lai_500m'),(/1,1/),(/NX_LAI,NY_LAI/),Lai_clim) ; VERIFY_(STATUS) - clim_lai = -9999. - where ((Lai_clim >=0).and.(Lai_clim <= 100)) - clim_lai = lai_clim * 0.1 - end where - where ((clim_lai >= 0.) .and. (clim_lai > clim_max)) - clim_max = clim_lai - end where - where ((clim_lai >= 0.) .and. (clim_lai < clim_min)) - clim_min = clim_lai - end where - STATUS = NF_CLOSE (NCID) - END DO + ! clim_lai = -9999. + ! where ((Lai_clim >=0).and.(Lai_clim <= 100)) + ! clim_lai = lai_clim * 0.1 + ! end where + ! where ((clim_lai >= 0.) .and. (clim_lai > clim_max)) + ! clim_max = clim_lai + ! end where + ! where ((clim_lai >= 0.) .and. (clim_lai < clim_min)) + ! clim_min = clim_lai + ! end where + ! STATUS = NF_CLOSE (NCID) + ! END DO - STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) - STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) - STATUS = NF_CLOSE (NCIDW) - deallocate (lai_clim, clim_lai, clim_min, clim_max) - endif + ! STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) + ! STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) + ! STATUS = NF_CLOSE (NCIDW) + ! deallocate (lai_clim, clim_lai, clim_min, clim_max) + ! endif allocate( var_in(NX_gripc,NY_gripc)) var_in = UNDEF @@ -1347,16 +1347,17 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG max_cnt = 0. allocate (LAI_MIN (NTILES)) allocate (LAI_MAX (NTILES)) + allocate (lai (NTILES)) LAI_MIN = -9999. LAI_MAX = -9999. - +!!!! Qui lo devo leggere ......... Ma se lo creo da lai.dat, Avra' dimensioni come le NTILES ! Read Min/Max LAI - allocate (clim_min (1:NX_LAI, 1: NY_LAI)) - allocate (clim_max (1:NX_LAI, 1: NY_LAI)) - status = NF_OPEN('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4', NF_NOWRITE, NCIDW); VERIFY_(STATUS) - STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) - STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) - STATUS = NF_CLOSE (NCIDW) + !!!! allocate (clim_min (1:NX_LAI, 1: NY_LAI)) + !!!! allocate (clim_max (1:NX_LAI, 1: NY_LAI)) + ! status = NF_OPEN('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4', NF_NOWRITE, NCIDW); VERIFY_(STATUS) + ! STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) + ! STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) + ! STATUS = NF_CLOSE (NCIDW) do j = 1,NY_gripc do i = 1,NX_gripc @@ -1367,19 +1368,19 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG if (var_in(i,j) == 3) PGRIPC(iraster (i,j)) = PGRIPC(iraster (i,j)) + 1. if (var_in(i,j) == 4) NGRIPC(iraster (i,j)) = NGRIPC(iraster (i,j)) + 1. - if(var_in(i,j) == 2) then - if(clim_min(i,j) < 10.) then - if(LAI_MIN(iraster (i,j)) < 0.) LAI_MIN(iraster (i,j)) = 0. - LAI_MIN (iraster (i,j)) = LAI_MIN (iraster (i,j)) + clim_min(i,j) - min_cnt (iraster (i,j)) = min_cnt (iraster (i,j)) + 1. - endif - - if(clim_max(i,j) >= 0.) then - if(LAI_MAX(iraster (i,j)) < 0.) LAI_MAX(iraster (i,j)) = 0. - LAI_MAX (iraster (i,j)) = LAI_MAX (iraster (i,j)) + clim_max(i,j) - max_cnt (iraster (i,j)) = max_cnt (iraster (i,j)) + 1. - endif - endif + ! if(var_in(i,j) == 2) then + ! if(clim_min(i,j) < 10.) then + ! if(LAI_MIN(iraster (i,j)) < 0.) LAI_MIN(iraster (i,j)) = 0. + ! LAI_MIN (iraster (i,j)) = LAI_MIN (iraster (i,j)) + clim_min(i,j) + ! min_cnt (iraster (i,j)) = min_cnt (iraster (i,j)) + 1. + ! endif + + ! if(clim_max(i,j) >= 0.) then + ! if(LAI_MAX(iraster (i,j)) < 0.) LAI_MAX(iraster (i,j)) = 0. + ! LAI_MAX (iraster (i,j)) = LAI_MAX (iraster (i,j)) + clim_max(i,j) + ! max_cnt (iraster (i,j)) = max_cnt (iraster (i,j)) + 1. + ! endif + ! endif endif end do end do @@ -1389,24 +1390,44 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG PGRIPC = PGRIPC / tot_cnt NGRIPC = NGRIPC / tot_cnt - where (max_cnt > 0.) LAI_MAX = LAI_MAX / max_cnt - where (min_cnt > 0.) LAI_MIN = LAI_MIN / min_cnt + ! where (max_cnt > 0.) LAI_MAX = LAI_MAX / max_cnt + ! where (min_cnt > 0.) LAI_MIN = LAI_MIN / min_cnt ! Fill LAI gaps ! ------------- ! print *, 'START LAI gap filling',COUNT(LAI_MAX >=0.), MAXVAL(LAI_MAX),count (IGRIPC > 0.) - DO I = 1, NTILES - IF((IGRIPC (I) > 0.) .AND. (LAI_MAX(I) < 0.)) THEN - j = getNeighbor (I,lai_in=LAI_MAX) - LAI_MIN (I) = LAI_MIN (j) - LAI_MAX (I) = LAI_MAX (j) - ENDIF - END DO + ! DO I = 1, NTILES + ! IF((IGRIPC (I) > 0.) .AND. (LAI_MAX(I) < 0.)) THEN + ! j = getNeighbor (I,lai_in=LAI_MAX) + ! LAI_MIN (I) = LAI_MIN (j) + ! LAI_MAX (I) = LAI_MAX (j) + ! ENDIF + ! END DO + allocate(dum) + allocate(yr) + allocate(mn) + allocate(dy) + allocate(nt) + + open (43,file='clsm/lai.dat', & + form='unformatted',status='unknown',convert='little_endian',action='read') + LAI_MAX=-9999. + LAI_MIN=9999. + do j = 1, 48 + read(43) yr,mn,dy,dum,dum,dum,yr,mn,dy,dum,dum,dum,nt,dum + read(43) lai + do i = 1, NTILES + if (lai(i)>LAI_MAX(i)) LAI_MAX(i)=lai(i) + if (lai(i) Date: Tue, 25 Jun 2024 14:12:09 -0700 Subject: [PATCH 17/55] Cleaned code and updated comments --- .../GEOS_IrrigationGridComp.F90 | 12 +-- .../irrigation_model.F90 | 27 ++---- .../Raster/makebcs/module_irrig_params.F90 | 94 ++----------------- 3 files changed, 23 insertions(+), 110 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 70bc3cba9..c7b5857fb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -560,11 +560,10 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! Update IRRIGFRAC and PADDYFRAC for applications that are run on regular tiles in which IRRIGFRAC and PADDYFRAC in BCs are fractions. - ! The irrigation model would run on tiles whose IRRIGFRAC + PADDYFRAC > IRRIG_THRES (defult is 0.5) assuming the larger - ! of the two fractions is the dominant surface type. + ! The irrigation model would run on tiles whose IRRIGFRAC + PADDYFRAC > IRRIG_THRES (default is 0.5). where (IRRIGFRAC + PADDYFRAC > IM%IRRIG_THRES) -!To assign the entire cell to the largest fraction remove comments 568-574 +!To assign the entire cell to the largest fraction remove comments 568-574, ! where (PADDYFRAC >= IRRIGFRAC) ! PADDYFRAC = 1. ! IRRIGFRAC = 0. @@ -597,8 +596,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! Scale computed SPRINKLERRATE, DRIPRATE, and FLOODRATE to the total ! irrigated tile fraction before exporting to land models. - ! Since revised IRRIGFRAC, and PADDYFRAC in subtiling mode are 0. or 1., below scaling - ! has no effect in that mode. + SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC + PADDYFRAC) DRIPRATE = DRIPRATE *(IRRIGFRAC + PADDYFRAC) @@ -836,9 +834,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! Scale computed SPRINKLERRATE, DRIPRATE, and FLOODRATE to the total ! irrigated tile fraction before exporting to land models. - ! Since revised IRRIGFRAC, and PADDYFRAC in subtiling mode are 0. or 1., below scaling - ! has no effect in that mode. - + SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC + PADDYFRAC) DRIPRATE = DRIPRATE *(IRRIGFRAC + PADDYFRAC) FLOODRATE = FLOODRATE *(IRRIGFRAC + PADDYFRAC) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 4519160bb..109782733 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -21,22 +21,17 @@ MODULE IRRIGATION_MODULE ! Drip irrigation method calculation is similar to that of sprinkler, albeit the drip irrigation method assumes a 0% water loss. ! ! March 21, 2021 (Sarith Mahanama) - First Version + ! June 25, 2024 (Stefano Casirati) - Second Version ! ! (1) EXPORTS - MODEL OUTPUTS TO THE LAND MODEL (IRRIGATION RATES): ! 1) SPRINKLERRATE [kg m-2 s-1] ! 2) DRIPRATE [kg m-2 s-1] ! 3) FLOODRATE [kg m-2 s-1] ! - ! (2) COMPUTATIONAL TILES: - ! During land BCs generation, land tiles where irrigated crops or paddy is present were further subdivided to a - ! mosaic of upto 3 fractions: i) non-irrigated land, ii) irrigated crop, or iii) paddy. - ! The model treats each fraction as a separate computational tile and runs on each individual fraction with own parameters and prognostics. - ! All fractions inherited model and soil parameters from the main land tile that they belong to. A special treatment of setting BF3 to a high - ! value (25.) was applied to paddy/crop tiles to account for the uniquely flat nature of farmlands. Vegetation characteristics and vegetation dynamic - ! parameters for irrigated crop and paddy tiles were taken from the nearest grass or crops land tile. - ! During tiling and BCs data preparation, computed fractional coverages for land tiles were also adjusted - ! to reflect each computational tile under the land grid component represents entirely one of the 3 irrigation surface types: a non-irrigated land, - ! OR a irrigated-crops OR a paddy tile. + ! (2) IRRIGATED AND PADDY TILES: + ! During land BC's generation, the fraction of irrigated crops and paddy is set to zero if their sum is below an irrigation threshold. + ! Irrigated fractions can be irrigated with sprinkler, drip, and flood, while paddy fractions can only be irrigated using the flood irrigation method. + ! Vegetation characteristics and vegetation dynamic parameters for irrigated crops and paddy tiles were taken from the nearest grass or cropland tile. ! ! (3) MODEL INPUTS: ! SMWP : rootzone soil moisture content at wilting point [mm] @@ -61,8 +56,10 @@ MODULE IRRIGATION_MODULE ! iii)3: Flood irrigation on entire tile. ! ! IRRIG_TRIGGER: 0 SPECIFIC INPUTS: - ! IRRIGFRAC : fraction of tile covered by irrigated crops (per Section 2, values will be 0. or 1.) - ! PADDYFRAC : fraction of tile covered by paddy (per Section 2, values will be 0. or 1.) + ! IRRIGFRAC : fraction of tile covered by irrigated crops (values between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation + ! Threshold) + ! PADDYFRAC : fraction of tile covered by paddy (values between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation + ! Threshold) ! SPRINKLERFR : fraction of tile equipped for sprinkler irrigation ! DRIPFR : fraction of tile equipped for drip irrigation ! FLOODFR : fraction of tile equipped for flood irrigation @@ -102,12 +99,6 @@ MODULE IRRIGATION_MODULE ! The second dimensions of 2D arrays is for different crop fractions i.e. the second dimension is 2 for above ! IRRIG_TRIGGER: 0 to separately store irrigation rates in irrigated crop and paddy fractions. ! It would be 26 for IRRIG_TRIGGER: 1. - ! Note also that runnning the irrigation model on subtiling mode (specific irrigated crop and paddy tiles with their own land prognostics) - ! is preferred (Section 2) to running the irrigation model on fractions of typical land tiles. For the subtiling mode with own soil moisture - ! prognostics, IRRIGFRAC, PADDYFRAC and CROPIRRIGFRAC fractions have been adjusted to represent irrigation type of the subtile in question. i.e. - ! IRRIFRAC has been set to 1. on irrigated-crop subtiles; PADDYFRAC and CROPIRRIGFRAC(N,3) are set to 1. on paddy subtiles; and SUM of - ! CROPIRRIGFRAC(N,:) excluding the 3rd element is set to 1. on irrigated crop tiles. - ! ! The crop calendar implemetation (IRRIG_TRIGGER: 1) computes SPRINKLERRATE, DRIPRATE, and FLOODRATE as weighted averages of irrigation rates from ! all active crops in SRATE, DRATE and FRATE arrays. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 index 3a4024d0e..af3e0e600 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -2,6 +2,8 @@ #define ASSERT_(A) if(.not.A)then;print *,'Error:',__FILE__,__LINE__;stop;endif module module_irrig_params +! Version 1 - Sarith Mahanama +! Version 2 - Stefano Casirati - LAI min-max obtained from LAI climatology boundary conditions use rmTinyCatchParaMod, ONLY : RegridRaster,regridrasterreal use process_hres_data, ONLY : get_country_codes @@ -143,7 +145,7 @@ subroutine create_irrig_params (nc, nr, gfile) allocate (GIAFRAC (NTILES)) call ReadProcess_GIA (NC, NR, NTILES, tile_id, GIAFRAC) - ! (4) Process GRIPC and MCD15A2H LAI + ! (4) Process GRIPC and LAI (Min-Max) ! ---------------------------------- allocate (IGRIPC (NTILES)) @@ -329,8 +331,8 @@ SUBROUTINE OpenFile date_time_values(1),'-',date_time_values(2),'-',date_time_values(3),'at', & date_time_values(5),':',date_time_values(6),':',date_time_values(7) - status = NF_PUT_ATT_TEXT(NCOutID, NF_GLOBAL, 'CreatedBy', LEN_TRIM('Sarith Mahanama'), & - 'Sarith Mahanama') ; VERIFY_(STATUS) + status = NF_PUT_ATT_TEXT(NCOutID, NF_GLOBAL, 'CreatedBy', LEN_TRIM('Sarith Mahanama, Stefano Casirati'), & + 'Sarith Mahanama, Stefano Casirati') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, NF_GLOBAL, 'Contact' , LEN_TRIM('sarith.p.mahanama@nasa.gov'), & 'sarith.p.mahanama@nasa.gov') status = NF_PUT_ATT_TEXT(NCOutID, NF_GLOBAL, 'Date' , LEN_TRIM(time_stamp),trim(time_stamp)) @@ -387,7 +389,7 @@ SUBROUTINE MergeData (NTILES) ALLOCATE (DRIP (1:NTILES)) CALL ReadProcess_IMethod (NTILES, sprinkler, drip, flood) - ! MERGING PROCEDURE + ! MERGING PROCEDURE ! ================= ! CROP CALENDAR ! GIA GIA-GRIPC GIA-GRIPC-MIRCA ------------- @@ -1271,50 +1273,8 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG real,allocatable :: dum,yr,mn,dy,nt logical :: write_lai = .false. - ! if (write_lai) then - - ! Process LAI first - ! ----------------- - - ! status = NF_CREATE ('land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4' , NF_NETCDF4, NCIDW) ; VERIFY_(STATUS) - ! status = NF_DEF_DIM(NCIDW, 'lon' , NX_LAI, xid) ; VERIFY_(STATUS) - ! status = NF_DEF_DIM(NCIDW, 'lat' , NY_LAI, yid) ; VERIFY_(STATUS) - ! status = NF_DEF_VAR(NCIDW, 'LAIMIN' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) - ! status = NF_DEF_VAR(NCIDW, 'LAIMAX' , NF_FLOAT, 2 ,(/xid,yid/), vid) ; VERIFY_(STATUS) - ! status = NF_ENDDEF(NCIDW) - - ! allocate (Lai_clim (1:NX_LAI, 1: NY_LAI)) - ! allocate (clim_min (1:NX_LAI, 1: NY_LAI)) - ! allocate (clim_max (1:NX_LAI, 1: NY_LAI)) - ! allocate (clim_lai (1:NX_LAI, 1: NY_LAI)) - ! clim_max = -9999. - ! clim_min = 9999. - - ! DO DOY = 1, 361, 8 - ! write (DDD, '(i3.3)') DOY - ! print *,trim(LAI_file)//DDD//'.nc4' - ! status = NF_OPEN(trim(LAI_file)//DDD//'.nc4',NF_NOWRITE, ncid); VERIFY_(STATUS) - ! STATUS = NF_GET_VARA_INT2 (NCID,VarID(NCID,'Lai_500m'),(/1,1/),(/NX_LAI,NY_LAI/),Lai_clim) ; VERIFY_(STATUS) - - ! clim_lai = -9999. - ! where ((Lai_clim >=0).and.(Lai_clim <= 100)) - ! clim_lai = lai_clim * 0.1 - ! end where - ! where ((clim_lai >= 0.) .and. (clim_lai > clim_max)) - ! clim_max = clim_lai - ! end where - ! where ((clim_lai >= 0.) .and. (clim_lai < clim_min)) - ! clim_min = clim_lai - ! end where - ! STATUS = NF_CLOSE (NCID) - ! END DO - - ! STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) - ! STATUS = NF_PUT_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) - ! STATUS = NF_CLOSE (NCIDW) - ! deallocate (lai_clim, clim_lai, clim_min, clim_max) - ! endif - + !V2: Min Max LAI from LAI Climatology for consistence + allocate( var_in(NX_gripc,NY_gripc)) var_in = UNDEF @@ -1350,15 +1310,7 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG allocate (lai (NTILES)) LAI_MIN = -9999. LAI_MAX = -9999. -!!!! Qui lo devo leggere ......... Ma se lo creo da lai.dat, Avra' dimensioni come le NTILES - ! Read Min/Max LAI - !!!! allocate (clim_min (1:NX_LAI, 1: NY_LAI)) - !!!! allocate (clim_max (1:NX_LAI, 1: NY_LAI)) - ! status = NF_OPEN('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/irrigation/lai_clim_min_max/v1/MCD15A2H.006_LAI_climMinMax.nc4', NF_NOWRITE, NCIDW); VERIFY_(STATUS) - ! STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMIN'),(/1,1/),(/NX_LAI,NY_LAI/),clim_min) ; VERIFY_(STATUS) - ! STATUS = NF_GET_VARA_REAL (NCIDW,VarID(NCIDW,'LAIMAX'),(/1,1/),(/NX_LAI,NY_LAI/),clim_max) ; VERIFY_(STATUS) - ! STATUS = NF_CLOSE (NCIDW) - + do j = 1,NY_gripc do i = 1,NX_gripc if((iraster (i,j) >=1).and.(iraster (i,j) <=ntiles)) then @@ -1368,19 +1320,6 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG if (var_in(i,j) == 3) PGRIPC(iraster (i,j)) = PGRIPC(iraster (i,j)) + 1. if (var_in(i,j) == 4) NGRIPC(iraster (i,j)) = NGRIPC(iraster (i,j)) + 1. - ! if(var_in(i,j) == 2) then - ! if(clim_min(i,j) < 10.) then - ! if(LAI_MIN(iraster (i,j)) < 0.) LAI_MIN(iraster (i,j)) = 0. - ! LAI_MIN (iraster (i,j)) = LAI_MIN (iraster (i,j)) + clim_min(i,j) - ! min_cnt (iraster (i,j)) = min_cnt (iraster (i,j)) + 1. - ! endif - - ! if(clim_max(i,j) >= 0.) then - ! if(LAI_MAX(iraster (i,j)) < 0.) LAI_MAX(iraster (i,j)) = 0. - ! LAI_MAX (iraster (i,j)) = LAI_MAX (iraster (i,j)) + clim_max(i,j) - ! max_cnt (iraster (i,j)) = max_cnt (iraster (i,j)) + 1. - ! endif - ! endif endif end do end do @@ -1390,19 +1329,6 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG PGRIPC = PGRIPC / tot_cnt NGRIPC = NGRIPC / tot_cnt - ! where (max_cnt > 0.) LAI_MAX = LAI_MAX / max_cnt - ! where (min_cnt > 0.) LAI_MIN = LAI_MIN / min_cnt - - ! Fill LAI gaps - ! ------------- - ! print *, 'START LAI gap filling',COUNT(LAI_MAX >=0.), MAXVAL(LAI_MAX),count (IGRIPC > 0.) - ! DO I = 1, NTILES - ! IF((IGRIPC (I) > 0.) .AND. (LAI_MAX(I) < 0.)) THEN - ! j = getNeighbor (I,lai_in=LAI_MAX) - ! LAI_MIN (I) = LAI_MIN (j) - ! LAI_MAX (I) = LAI_MAX (j) - ! ENDIF - ! END DO allocate(dum) allocate(yr) allocate(mn) @@ -1429,7 +1355,7 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG deallocate (var_in, iraster, min_cnt, max_cnt, tot_cnt, LAI_MIN, LAI_MAX, lai, yr, mn, dy, dum, nt) - print *,'DONE PROCESSING GRIPC and MCD15A2H LAI' + print *,'DONE PROCESSING GRIPC and LAI' END SUBROUTINE ReadProcess_GRIPC From a431a6b1b358dd42a14b23759bba3981db5050f3 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Thu, 29 Aug 2024 16:48:56 -0700 Subject: [PATCH 18/55] Flood irrigation separated into Furrow and Flood irrigation --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 5 +- .../GEOS_CatchCNGridComp.F90 | 11 +++- .../GEOS_CatchCNCLM40GridComp.F90 | 18 +++++- .../GEOS_CatchCNCLM45GridComp.F90 | 18 +++++- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 18 +++++- .../GEOS_IrrigationGridComp.F90 | 53 +++++++++++------- .../irrigation_model.F90 | 55 +++++++++++-------- 7 files changed, 127 insertions(+), 51 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 2c0d19428..1c168ed63 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -1347,6 +1347,7 @@ subroutine SetServices ( GC, RC ) if (RUN_IRRIG == 1) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPRINKLERRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FLOODRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FURROWRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRIPRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) end if @@ -1465,7 +1466,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FLOODRATE '/),& + SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FURROWRATE','FLOODRATE '/),& SRC_ID = IRRIGATION(I) ,& DST_ID = CATCH(I) ,& RC = STATUS ) @@ -1516,7 +1517,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FLOODRATE '/),& + SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FURROWRATE','FLOODRATE '/),& SRC_ID = IRRIGATION(I) ,& DST_ID = CATCH(I) ,& RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 177854486..15128c856 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -688,7 +688,16 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) - + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'FURROWRATE' ,& + LONG_NAME = 'furrow_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'FLOODRATE' ,& LONG_NAME = 'flood_irrigation_rate' ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 34d35e2c1..8585d0194 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -788,6 +788,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'FURROWRATE' ,& + LONG_NAME = 'furrow_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'FLOODRATE' ,& LONG_NAME = 'flood_irrigation_rate' ,& @@ -4520,6 +4529,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: NDVI real, dimension(:), pointer :: SPRINKLERRATE real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FURROWRATE real, dimension(:), pointer :: FLOODRATE real, dimension(:,:), pointer :: DUDP real, dimension(:,:), pointer :: DUSV @@ -5178,6 +5188,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,DRIPRATE,'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,FLOODRATE,'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FURROWRATE,'FURROWRATE' ,RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- ! INTERNAL Pointers @@ -6961,7 +6972,10 @@ subroutine Driver ( RC ) RZEXC = RZEXC + DRIPRATE*DT end where where (FLOODRATE > 0) - RZEXC = RZEXC + FLOODRATE*DT + SRFEXC = SRFEXC + FLOODRATE*DT + end where + where (FURROWRATE > 0) + RZEXC = RZEXC + FURROWRATE*DT end where ENDIF #ifdef DBG_CNLSM_INPUTS @@ -7384,7 +7398,7 @@ subroutine Driver ( RC ) if(associated( ACCUM)) ACCUM = SLDTOT - EVPICE*(1./MAPL_ALHS) - SMELT if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT if(associated(IRRLAND)) then - if (catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE + if (catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FURROWRATE + FLOODRATE + DRIPRATE endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(EVPSNO)) EVPSNO = EVPICE diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index c9fb7d417..383d1217a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -791,6 +791,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'FURROWRATE' ,& + LONG_NAME = 'furrow_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'FLOODRATE' ,& LONG_NAME = 'flood_irrigation_rate' ,& @@ -4485,6 +4494,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: SPRINKLERRATE real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FURROWRATE real, dimension(:), pointer :: FLOODRATE real, dimension(:,:), pointer :: DUDP @@ -5198,6 +5208,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,DRIPRATE, 'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FURROWRATE, 'FURROWRATE' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,FLOODRATE, 'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- @@ -7244,7 +7255,10 @@ subroutine Driver ( RC ) RZEXC = RZEXC + DRIPRATE*DT end where where (FLOODRATE > 0) - RZEXC = RZEXC + FLOODRATE*DT + SRFEXC = SRFEXC + FLOODRATE*DT + end where + where (FURROWRATE > 0) + RZEXC = RZEXC + FURROWRATE*DT end where ENDIF @@ -7671,7 +7685,7 @@ subroutine Driver ( RC ) if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT if(associated(IRRLAND)) then - if(catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE + if(catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FURROWRATE + FLOODRATE + DRIPRATE endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(DRPARLAND)) DRPARLAND = DRPAR diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 8cbcde6a3..b86314787 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -761,6 +761,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'furrow_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FURROWRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddImportSpec(GC ,& LONG_NAME = 'flood_irrigation_rate' ,& UNITS = 'kg m-2 s-1' ,& @@ -3753,6 +3762,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: NDVI real, dimension(:), pointer :: SPRINKLERRATE real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FURROWRATE real, dimension(:), pointer :: FLOODRATE real, dimension(:,:), pointer :: DUDP @@ -4322,6 +4332,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,DRIPRATE, 'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FURROWRATE, 'FURROWRATE' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,FLOODRATE, 'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) @@ -5099,8 +5110,11 @@ subroutine Driver ( RC ) where (DRIPRATE > 0) RZEXC = RZEXC + DRIPRATE*DT end where + where (FURROWRATE > 0) + RZEXC = RZEXC + FURROWRATE*DT + end where where (FLOODRATE > 0) - RZEXC = RZEXC + FLOODRATE*DT + SRFEXC = SRFEXC + FLOODRATE*DT end where endif @@ -5749,7 +5763,7 @@ subroutine Driver ( RC ) if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT if(associated(IRRLAND)) then - if (CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FLOODRATE + DRIPRATE + if (CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FURROWRATE +FLOODRATE + DRIPRATE endif if(associated(SNOLAND)) SNOLAND = SLDTOT ! note, not just SNO if(associated(DRPARLAND)) DRPARLAND = DRPAR diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index c7b5857fb..f20f3e96f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -16,8 +16,9 @@ module GEOS_IrrigationGridCompMod ! dynamic vegetation values prescribed by external data/observations.\\ ! ! Exports from this routine are the instaneous values of the -! irrigation rates from 3 different irrigation methods on tilespace : -! 1) drip, 2) sprinkler and 3) flood. Because Land models (CATCH/CATCHCN) use +! irrigation rates from 4 different irrigation methods on tilespace : +! 1) drip, 2) sprinkler, 3) furrow, and 4) flood. +! Because Land models (CATCH/CATCHCN) use ! irrigation rates as a water input in water budget calculation, ! All exports and imports are stored on the ! tile grid inherited from the parent routine.\\ @@ -28,7 +29,7 @@ module GEOS_IrrigationGridCompMod ! The gridded component stores the surrounding observations of ! each parameter in the internal state. All internals are static parameters. ! -! EXPORTS: SPRINKLERRATE, DRIPRATE, FLOODRATE\\ +! EXPORTS: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE\\ ! ! INTERNALS: IRRIGFRAC, PADDYFRAC, CROPIRRIGFRAC, IRRIGPLANT, IRRIGHARVEST, ! IRRIGTYPE, SPRINKLERFR, DRIPFR, FLOODFR, LAIMIN, LAIMAX\\ @@ -114,7 +115,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - + Iam = trim(COMP_NAME) // 'SetServices' ! ----------------------------------------------------------- @@ -380,6 +381,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + SHORT_NAME = 'FURROWRATE' ,& + LONG_NAME = 'furrow_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& SHORT_NAME = 'FLOODRATE' ,& LONG_NAME = 'flood_irrigation_rate' ,& @@ -510,6 +520,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) real, dimension(:), pointer :: SPRINKLERRATE real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FURROWRATE real, dimension(:), pointer :: FLOODRATE type(irrigation_model),pointer :: IM @@ -557,13 +568,14 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! ------------------------------- call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! Update IRRIGFRAC and PADDYFRAC for applications that are run on regular tiles in which IRRIGFRAC and PADDYFRAC in BCs are fractions. - ! The irrigation model would run on tiles whose IRRIGFRAC + PADDYFRAC > IRRIG_THRES (default is 0.5). + ! The irrigation model would run on tiles whose IRRIGFRAC + PADDYFRAC > IRRIG_THRES (default is 0.01). where (IRRIGFRAC + PADDYFRAC > IM%IRRIG_THRES) -!To assign the entire cell to the largest fraction remove comments 568-574, + !to assign the entire cell to the largest fraction remove comments below, ! where (PADDYFRAC >= IRRIGFRAC) ! PADDYFRAC = 1. ! IRRIGFRAC = 0. @@ -581,7 +593,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! LAI based trigger: scale soil moisture to LAI seasonal cycle ! ============================================================ - call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) else @@ -589,18 +601,19 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! crop calendar based irrigation ! ============================== - call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE & CROPIRRIGFRAC,SRATE,DRATE,FRATE) endif - ! Scale computed SPRINKLERRATE, DRIPRATE, and FLOODRATE to the total + ! Scale computed SPRINKLERRATE, DRIPRATE, FURROWRATE, and FLOODRATE to the total ! irrigated tile fraction before exporting to land models. - SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC + PADDYFRAC) - DRIPRATE = DRIPRATE *(IRRIGFRAC + PADDYFRAC) - FLOODRATE = FLOODRATE *(IRRIGFRAC + PADDYFRAC) + SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC) + DRIPRATE = DRIPRATE *(IRRIGFRAC) + FURROWRATE = FURROWRATE *(IRRIGFRAC) + FLOODRATE = FLOODRATE *(PADDYFRAC) call MAPL_TimerOff(MAPL,"INITIALIZE") RETURN_(ESMF_SUCCESS) @@ -654,6 +667,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) real, dimension(:), pointer :: SPRINKLERRATE real, dimension(:), pointer :: DRIPRATE + real, dimension(:), pointer :: FURROWRATE real, dimension(:), pointer :: FLOODRATE ! IMPORT pointers @@ -799,7 +813,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! If we want to switch to FIELDCAP in the future, that has already been derived on tiles and available ! in irrigation_IMxJM_DL.dat file. - SMREF (n) = VGWMAX (n) * (wpwet (n) + (1. - wpwet (n))/2.5) + SMREF (n) = VGWMAX (n) * (wpwet (n) + (1. - wpwet (n))/ 3.) ! rootzone moisture deficit to reach complete soil saturation for paddy [mm] @@ -815,7 +829,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) call IM%run_model(IRRIG_METHOD, local_hour, & IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & SMWP,SMSAT,SMREF,SMCNT, LAI, LAIMIN, LAIMAX, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, & + SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, & SRATE, DRATE, FRATE) else @@ -827,17 +841,18 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) SPRINKLERFR, DRIPFR, FLOODFR, & CROPIRRIGFRAC,IRRIGPLANT,IRRIGHARVEST,IRRIGTYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, & + SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, & SRATE, DRATE, FRATE) endif - ! Scale computed SPRINKLERRATE, DRIPRATE, and FLOODRATE to the total + ! Scale computed SPRINKLERRATE, DRIPRATE, FURROWRATE, and FLOODRATE to the total ! irrigated tile fraction before exporting to land models. - SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC + PADDYFRAC) - DRIPRATE = DRIPRATE *(IRRIGFRAC + PADDYFRAC) - FLOODRATE = FLOODRATE *(IRRIGFRAC + PADDYFRAC) + SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC) + DRIPRATE = DRIPRATE *(IRRIGFRAC) + FURROWRATE = FURROWRATE *(IRRIGFRAC) + FLOODRATE = FLOODRATE *(PADDYFRAC) deallocate (local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF, IM) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 109782733..171c6640d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -110,9 +110,9 @@ MODULE IRRIGATION_MODULE ! Below parameters can be set via RC file. - REAL :: irrig_thres = 0.5 ! threshold of tile fraction to turn the irrigation model on. + REAL :: irrig_thres = 0.01 ! threshold of tile fraction to turn the irrigation model on. REAL :: lai_thres = 0.6 ! threshold of LAI range to turn irrigation on - REAL :: efcor = 30.0 ! Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use) + REAL :: efcor = 25.0 ! Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use) REAL :: MIDS_LENGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER: 1) ! Sprinkler parameters @@ -129,7 +129,7 @@ MODULE IRRIGATION_MODULE ! Flood parameters ! ---------------- REAL :: flood_stime = 6.0 ! flood irrigatrion start time [hours] - REAL :: flood_dur = 1.0 ! flood irrigation duration [hours] + REAL :: flood_dur = 8.0 ! flood irrigation duration [hours] REAL :: flood_thres = 0.6 ! soil moisture threshhold to trigger flood irrigation @@ -193,7 +193,7 @@ END SUBROUTINE init_model SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN,LAIMAX, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, SRATE, DRATE, FRATE) + SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE, SRATE, DRATE, FRATE) implicit none class (irrigation_model), intent(inout) :: this @@ -201,7 +201,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & real, dimension (:), intent (in) :: local_hour real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC, SPRINKLERFR, & DRIPFR, FLOODFR, SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN, LAIMAX, RZDEF - real, dimension (:), intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + real, dimension (:), intent (inout) :: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE INTEGER :: NTILES, N, crop REAL :: ma, H1, H2, HC, IT, ROOTFRAC, LAITHRES @@ -303,7 +303,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & ! turn off irrigation if LAI is smaller than the LAI trigger marking end of the season if(season_end) then - DO crop = 1, 2 + DO crop = 1, 2 ! With LAI trigger Crop 1 = Irrigated Fraction, Crop 2 = Paddy Fraction SRATE (N,crop) = 0. DRATE (N,crop) = 0. FRATE (N,crop) = 0. @@ -312,10 +312,10 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & END DO TILE_LOOP - ! Update SPRINKLERRATE, DRIPRATE, FLOODRATE EXPORTS to be sent to land models. + ! Update SPRINKLERRATE, DRIPRATE, FURROW, FLOODRATE EXPORTS to be sent to land models. ! FLOODRATE is weighted averaged over irrigated crops + paddy fractions. - call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + call this%update_irates (SPRINKLERRATE,DRIPRATE,FURROWRATE,FLOODRATE, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) END SUBROUTINE irrigrate_lai_trigger @@ -326,7 +326,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & SPRINKLERFR, DRIPFR, FLOODFR, & CROPIRRIGFRAC,IRRIGPLANT, IRRIGHARVEST, IRRIGTYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, SRATE, DRATE, FRATE) + SPRINKLERRATE, DRIPRATE,FURROWRATE, FLOODRATE, SRATE, DRATE, FRATE) implicit none class(irrigation_model),intent(inout):: this @@ -337,7 +337,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & real, dimension(:,:), intent (in) :: IRRIGTYPE ! NUM_CROPS real, dimension(:,:,:),intent (in) :: IRRIGPLANT ! NUM_SEASONS, NUM_CROPS real, dimension(:,:,:),intent (in) :: IRRIGHARVEST ! NUM_SEASONS, NUM_CROPS - real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE INTEGER :: NTILES, N, crop, sea, ITYPE, I REAL :: ma, H1, H2, HC, IT, ROOTFRAC, void_frac @@ -459,17 +459,17 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & endif IF_IRR END DO TILE_LOOP - ! Update SPRINKLERRATE, DRIPRATE, FLOODRATE EXPORTS to be sent to land models + ! Update SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE EXPORTS to be sent to land models ! They are weighted averaged over 26 crop fractions. - call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, & + call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & CROPIRRIGFRAC,SRATE,DRATE,FRATE) END SUBROUTINE irrigrate_crop_calendar ! ---------------------------------------------------------------------------- - SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, & + SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FURROWRATE,FLOODRATE, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) implicit none @@ -477,13 +477,14 @@ SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, & class(irrigation_model),intent(inout):: this real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE - real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE integer :: N, NT ! INITIALIZE EXPORTS SPRINKLERRATE = 0. DRIPRATE = 0. FLOODRATE = 0. + FURROWRATE = 0. NT = size (IRRIGFRAC) @@ -493,8 +494,8 @@ SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, & IF ((IRRIGFRAC(N) + PADDYFRAC(N)) > 0.) THEN SPRINKLERRATE (N) = SRATE (N,1) DRIPRATE (N) = DRATE (N,1) - FLOODRATE (N) = (IRRIGFRAC(N)* FRATE (N,1) + PADDYFRAC(N)*FRATE (N,2)) & - /(IRRIGFRAC(N) + PADDYFRAC(N)) + FURROWRATE (N) = FRATE (N,1) + FLOODRATE (N) = FRATE (N,2) ENDIF END DO @@ -502,30 +503,35 @@ END SUBROUTINE update_irates_lai !............................................................................... - SUBROUTINE update_irates_ccalendar(this,SPRINKLERRATE,DRIPRATE,FLOODRATE, & + SUBROUTINE update_irates_ccalendar(this,SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & CROPIRRIGFRAC,SRATE,DRATE,FRATE) implicit none class(irrigation_model),intent(inout):: this real, dimension(:,:), intent (in) :: CROPIRRIGFRAC ! NUM_CROPS real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE - real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE + real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE,FURROWRATE integer :: N, NT, crop ! INITIALIZE EXPORTS SPRINKLERRATE = 0. DRIPRATE = 0. FLOODRATE = 0. + FURROWRATE = 0. !_ASSERT(size (SRATE,2)==NUM_CROPS,'Irrigation model crop calandar trigger NUM_CROPS mismatch') - - NT = size (SPRINKLERRATE) + NT = size (SPRINKLERRATE) DO N = 1, NT if(SUM(CROPIRRIGFRAC(N,:)) > 0.) then DO crop = 1, NUM_CROPS SPRINKLERRATE(N) = SPRINKLERRATE(N) + SRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) DRIPRATE(N) = DRIPRATE(N) + DRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + if (crop==3) then + ! If crop is rice (crop ==3) then use flood irrigation. Otherwise use furrow irrigation. FLOODRATE(N) = FLOODRATE(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + else + FURROWRATE(N) = FURROWRATE(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + endif END DO endif END DO @@ -565,9 +571,9 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, IT = this%sprinkler_thres if ((HC >= H1).AND.(HC < H2)) then ! use SMCNT at H1 during H1 <= HC < H2 to compute irrigrate. - ! Notice drip uses the same soil moisture threshold of sprinkler but with 0.% efficiency correction. + ! Notice drip uses the same soil moisture threshold of sprinkler but with 10.% efficiency correction. if((ma <= IT).AND.(H1 == HC)) & - DRATE = this%cwd(ROOTFRAC,SMCNT,SMREF,0.)/(H2 - H1)/3600. + DRATE = this%cwd(ROOTFRAC,SMCNT,SMREF,10.)/(H2 - H1)/3600. else DRATE = 0. endif @@ -580,8 +586,11 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, IT = this%flood_thres if ((HC >= H1).AND.(HC < H2)) then ! use SMCNT at H1 during H1 <= HC < H2 to compute irrigrate. + ! Notice Flood / Furrow irrigation uses the same soil moisture threshold of sprinkler but with + ! the efficiency correction increased by 15 (e.g., Field application efficiency Sprinkler 75%, Surface Irrigation 60%. + ! Source FAO) if((ma <= IT).AND.(H1 == HC)) & - FRATE = this%cwd (ROOTFRAC,SMCNT,SMREF,this%efcor)/(H2 - H1)/3600. + FRATE = this%cwd (ROOTFRAC,SMCNT,SMREF,this%efcor+15.)/(H2 - H1)/3600. else FRATE = 0. endif From a9d65c41710f1dcd10b7f809e8dc77d1c5277e3d Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Thu, 29 Aug 2024 17:33:29 -0700 Subject: [PATCH 19/55] fixed typo --- .../GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index f20f3e96f..67a5f2435 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -593,7 +593,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! LAI based trigger: scale soil moisture to LAI seasonal cycle ! ============================================================ - call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE & + call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) else @@ -601,7 +601,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! crop calendar based irrigation ! ============================== - call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE & + call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & CROPIRRIGFRAC,SRATE,DRATE,FRATE) endif From 6b951876d62da8ecc3225d8fe5b8028825c4152e Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Wed, 4 Sep 2024 10:52:45 -0700 Subject: [PATCH 20/55] code fix --- .../GEOS_IrrigationGridComp.F90 | 2 + .../irrigation_model.F90 | 54 ++++++++++--------- 2 files changed, 32 insertions(+), 24 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 67a5f2435..0af7cf765 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -744,6 +744,8 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + ! get pointers to IMPORT variables diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 171c6640d..30b47b959 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -6,32 +6,38 @@ MODULE IRRIGATION_MODULE USE ESMF IMPLICIT NONE - - ! This module computes irrigation rates by 3 different methods: sprinkler, flood and drip. + ! Irrigation Module + ! First Version: March 21, 2021 (Sarith Mahanama) + ! Second Version: June 25, 2024 (Stefano Casirati) + ! + ! This module computes irrigation rates by 4 different methods: sprinkler, flood, furrow, and drip. ! Computed irrigation rates return to the land model as rates that water is added to ! the hydrological cycle by irrigation. Subsequently, land models add irrigation feedback: - ! sprinkler irrigation rate to large scale precipitation; - ! drip irrigation volume to rootzone excess; and - ! flood irrigation volume to rootzone excess. + ! 1) sprinkler irrigation rate to large scale precipitation (for irrigated tiles fractions); + ! 2) drip irrigation volume to rootzone excess (for irrigated tiles fractions); + ! 3) furrow irrigation volume to rootzone excess (for irrigated tiles fractions); + ! 4) flood irrigation volume to surface excess (only for paddy tiles fractions). + ! The model uses rootzone soil moisture state at the local start time of irrigation to compute ! irrigation rates for the day and maintains the same rate through out the irrigation duration. ! - ! Sprinkler and Flood Irrigation methods were adapted from LIS CLSMF2.5 irrigatrion module: - ! https://github.com/NASA-LIS/LISF/blob/master/lis/surfacemodels/land/clsm.f2.5/irrigation/clsmf25_getirrigationstates.F90 - ! Drip irrigation method calculation is similar to that of sprinkler, albeit the drip irrigation method assumes a 0% water loss. - ! - ! March 21, 2021 (Sarith Mahanama) - First Version - ! June 25, 2024 (Stefano Casirati) - Second Version + ! Sprinkler and Flood/Furrow Irrigation methods were adapted from LIS CLSMF2.5 irrigation module (Rodell et al., 2024 (Under Review) + ! Drip irrigation method calculation is similar to that of sprinkler, albeit the drip irrigation method assumes a 10% water loss. (Source FAO) + ! ! ! (1) EXPORTS - MODEL OUTPUTS TO THE LAND MODEL (IRRIGATION RATES): ! 1) SPRINKLERRATE [kg m-2 s-1] ! 2) DRIPRATE [kg m-2 s-1] - ! 3) FLOODRATE [kg m-2 s-1] + ! 3) FURROWRATE [kg m-2 s-1] + ! 4) FLOODRATE [kg m-2 s-1] ! ! (2) IRRIGATED AND PADDY TILES: - ! During land BC's generation, the fraction of irrigated crops and paddy is set to zero if their sum is below an irrigation threshold. - ! Irrigated fractions can be irrigated with sprinkler, drip, and flood, while paddy fractions can only be irrigated using the flood irrigation method. - ! Vegetation characteristics and vegetation dynamic parameters for irrigated crops and paddy tiles were taken from the nearest grass or cropland tile. + ! During land BC's generation, the fraction of irrigated crops and paddy is set to zero + ! if their sum is below an irrigation threshold (default 1%). + ! Irrigated fractions can be irrigated with sprinkler, drip, and furrow, + ! while paddy fractions can only be irrigated using the flood irrigation method. + ! Vegetation characteristics and vegetation dynamic parameters + ! for irrigated crops and paddy tiles were taken from the nearest grass or cropland tile. ! ! (3) MODEL INPUTS: ! SMWP : rootzone soil moisture content at wilting point [mm] @@ -50,10 +56,10 @@ MODULE IRRIGATION_MODULE ! ! This LAI-based trigger is also equipped with an additional control parameter, IRRIG_METHOD, which is good to choose the method of irrigation ! that woould run on corresponding fractions - ! i) 0: (Default) All 3 methods (sprinkler/flood/drip) concurrently. + ! i) 0: (Default) All 4 methods (sprinkler/furrow/flood/drip) concurrently. ! ii) 1: Sprinkler irrigation on entire tile. ! iv) 2: Drip irrigation on entire tile. - ! iii)3: Flood irrigation on entire tile. + ! iii)3: Furrow/Flood irrigation on entire tile. ! ! IRRIG_TRIGGER: 0 SPECIFIC INPUTS: ! IRRIGFRAC : fraction of tile covered by irrigated crops (values between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation @@ -62,7 +68,7 @@ MODULE IRRIGATION_MODULE ! Threshold) ! SPRINKLERFR : fraction of tile equipped for sprinkler irrigation ! DRIPFR : fraction of tile equipped for drip irrigation - ! FLOODFR : fraction of tile equipped for flood irrigation + ! FLOODFR : fraction of tile equipped for flood/furrow irrigation ! LAI : time varying Leaf Area Index from the model ! LAIMIN : Minimum LAI spatially averaged over the irrigated tile fraction ! LAIMAX : Maximum LAI spatially averaged over the irrigated tile fraction @@ -86,7 +92,7 @@ MODULE IRRIGATION_MODULE ! IRRIG_TRIGGER: 1 SPECIFIC INPUTS: ! DOFYR : day of year ! IRRIGTYPE : Preferred Irrig method (NTILES, 26) - - ! (0)CONCURRENT (default), (1)SPRINKLER ONLY (2)DRIP ONLY (3)FLOOD ONLY, and (-negative) AVOID this method + ! (0)CONCURRENT (default), (1)SPRINKLER ONLY (2)DRIP ONLY (3)FLOOD/FURROW ONLY, and (-negative) AVOID this method ! CROPIRRIGFRAC: Crop irrigated fraction (NTILES, 26) (per Section 2, fractions have been adjusted such that ! CROPIRRIGFRAC is 1. on paddy tiles; the sum of available crop fractions is 1. on irrigated crop tiles; ! and is zero on non-irrigated tiles. @@ -99,7 +105,7 @@ MODULE IRRIGATION_MODULE ! The second dimensions of 2D arrays is for different crop fractions i.e. the second dimension is 2 for above ! IRRIG_TRIGGER: 0 to separately store irrigation rates in irrigated crop and paddy fractions. ! It would be 26 for IRRIG_TRIGGER: 1. - ! The crop calendar implemetation (IRRIG_TRIGGER: 1) computes SPRINKLERRATE, DRIPRATE, and FLOODRATE as weighted averages of irrigation rates from + ! The crop calendar implemetation (IRRIG_TRIGGER: 1) computes SPRINKLERRATE, DRIPRATE,FURROWRATE, and FLOODRATE as weighted averages of irrigation rates from ! all active crops in SRATE, DRATE and FRATE arrays. PRIVATE @@ -236,7 +242,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & if(ma >= 0) then SELECT CASE (IRRIG_METHOD) - CASE (0) ! CONCURRENTLY SPRINKER + FLOOD + DRIP on corresponding fractions + CASE (0) ! CONCURRENTLY SPRINKER + FLOOD + FURROW + DRIP on corresponding fractions call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & SRATE = SRATE (N,1), & @@ -312,7 +318,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & END DO TILE_LOOP - ! Update SPRINKLERRATE, DRIPRATE, FURROW, FLOODRATE EXPORTS to be sent to land models. + ! Update SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE EXPORTS to be sent to land models. ! FLOODRATE is weighted averaged over irrigated crops + paddy fractions. call this%update_irates (SPRINKLERRATE,DRIPRATE,FURROWRATE,FLOODRATE, & @@ -580,13 +586,13 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, endif if(present (FRATE)) then - ! FLOOD IRRIGATION + ! FURROW IRRIGATION H1 = this%flood_stime H2 = this%flood_stime + this%flood_dur IT = this%flood_thres if ((HC >= H1).AND.(HC < H2)) then ! use SMCNT at H1 during H1 <= HC < H2 to compute irrigrate. - ! Notice Flood / Furrow irrigation uses the same soil moisture threshold of sprinkler but with + ! Notice Furrow irrigation uses the same soil moisture threshold of sprinkler but with ! the efficiency correction increased by 15 (e.g., Field application efficiency Sprinkler 75%, Surface Irrigation 60%. ! Source FAO) if((ma <= IT).AND.(H1 == HC)) & From c7609703cd64ad8db182354136fe6ca2d4cf560b Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 25 Sep 2024 16:50:02 -0400 Subject: [PATCH 21/55] minor cleanup for Irrigation module --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 83 ++++--- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 52 ++-- .../GEOS_IrrigationGridComp.F90 | 230 +++++++++--------- .../irrigation_model.F90 | 166 +++++++------ 4 files changed, 275 insertions(+), 256 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index f8f3a05df..55c3f4935 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -14,13 +14,13 @@ module GEOS_LandGridCompMod ! to determine relevant time-dependent land-surface characteristics. ! All parameters calculated in VegdynGridComp are required by CatchGridComp. ! Furthermore, several exports of the Vegdyn routines are also exports -! from the Land composite, for use in other modules, such as the case -! for lai and grn needed in radiation. Vegdyn will be updated first. -! Then the catchment call will be issued. Then the catchment call will be issued. IrrigationGridComp -! was added to compute IRRIGRATE IMPORT required by land models. The composite exports -! consist of the union of the catchment exports with a subset of the -! vegdyn exports. All imports and exports are on the prescribed tile -! grid in the (IM, JM)=(NTILES, 1) convention. +! from the Land composite, for use in other modules. For example, +! lai and grn are needed in radiation. Vegdyn will be updated first. +! Then the catchment call will be issued. IrrigationGridComp +! was added to compute the irrigation rate IMPORT required by land models. +! The composite exports consist of the union of the catchment exports with a +! subset of the vegdyn exports. All imports and exports are on the prescribed +! tile grid in the (IM, JM)=(NTILES, 1) convention. ! ! !USES: @@ -28,12 +28,12 @@ module GEOS_LandGridCompMod use ESMF use MAPL - use GEOS_VegdynGridCompMod, only : VegdynSetServices => SetServices - use GEOS_CatchGridCompMod, only : CatchSetServices => SetServices - use GEOS_CatchCNGridCompMod, only : CatchCNSetServices => SetServices - use GEOS_IgniGridCompMod, only : IgniSetServices => SetServices + use GEOS_VegdynGridCompMod, only : VegdynSetServices => SetServices + use GEOS_CatchGridCompMod, only : CatchSetServices => SetServices + use GEOS_CatchCNGridCompMod, only : CatchCNSetServices => SetServices + use GEOS_IgniGridCompMod, only : IgniSetServices => SetServices use GEOS_IrrigationGridCompMod, only : IrrigationSetServices => SetServices - ! use GEOS_RouteGridCompMod, only : RouteSetServices => SetServices + ! use GEOS_RouteGridCompMod, only : RouteSetServices => SetServices implicit none private @@ -70,7 +70,8 @@ subroutine SetServices ( GC, RC ) ! !DESCRIPTION: The SetServices for the Physics GC needs to register its ! Initialize and Run. It uses the MAPL\_Generic construct for defining ! state specs and couplings among its children. In addition, it creates the -! children GCs (VegDyn, Catch, CatchCN, Irrigation, Route) and runs their respective SetServices. +! children GCs (VegDyn, Catch, CatchCN, Irrigation, Route) and runs their +! respective SetServices. !EOP @@ -156,11 +157,11 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) - call MAPL_GetResource (SCF, RUN_ROUTE, label='RUN_ROUTE:', DEFAULT=0, __RC__ ) - call MAPL_GetResource (SCF, RUN_IRRIG, label='RUN_IRRIG:', DEFAULT=0, __RC__ ) - call MAPL_GetResource (SCF, DO_GOSWIM, label='N_CONST_LAND4SNWALB:', DEFAULT=0, __RC__ ) - call MAPL_GetResource (SCF, DO_FIRE_DANGER, label='FIRE_DANGER:', DEFAULT=.false., __RC__ ) - call ESMF_ConfigDestroy (SCF, __RC__) + call MAPL_GetResource (SCF, RUN_ROUTE, label='RUN_ROUTE:', DEFAULT=0, __RC__ ) + call MAPL_GetResource (SCF, RUN_IRRIG, label='RUN_IRRIG:', DEFAULT=0, __RC__ ) + call MAPL_GetResource (SCF, DO_GOSWIM, label='N_CONST_LAND4SNWALB:', DEFAULT=0, __RC__ ) + call MAPL_GetResource (SCF, DO_FIRE_DANGER, label='FIRE_DANGER:', DEFAULT=.false., __RC__ ) + call ESMF_ConfigDestroy(SCF, __RC__) SELECT CASE (LSM_CHOICE) @@ -200,8 +201,9 @@ subroutine SetServices ( GC, RC ) if(RUN_IRRIG==1) then allocate (IRRIGATION(NUM_CATCH), stat=status) + VERIFY_(STATUS) if (NUM_CATCH == 1) then - IRRIGATION(1) = MAPL_AddChild(GC, NAME='IRRIGATION', SS=IrrigationSetServices, RC=STATUS) + IRRIGATION(1) = MAPL_AddChild(GC, NAME='IRRIGATION'//trim(tmp), SS=IrrigationSetServices, RC=STATUS) VERIFY_(STATUS) else do I = 1, NUM_CATCH @@ -550,7 +552,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, & SHORT_NAME = 'IRRLAND', & - CHILD_ID = CATCH(1), & RC=STATUS ) + CHILD_ID = CATCH(1), & + RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, & SHORT_NAME = 'SNOLAND', & @@ -1378,7 +1381,7 @@ subroutine SetServices ( GC, RC ) if (RUN_IRRIG == 1) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPRINKLERRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FLOODRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FURROWRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FURROWRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRIPRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) end if @@ -1489,7 +1492,8 @@ subroutine SetServices ( GC, RC ) if (RUN_IRRIG == 1) then call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'POROS ','WPWET ','VGWMAX ','WCRZ '/) ,& + SHORT_NAME = (/'POROS ', 'WPWET ' ,& + 'VGWMAX ', 'WCRZ '/) ,& SRC_ID = CATCH(I) ,& DST_ID = IRRIGATION(I) ,& RC = STATUS ) @@ -1497,7 +1501,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FURROWRATE','FLOODRATE '/),& + SHORT_NAME = (/'SPRINKLERRATE', 'DRIPRATE ' ,& + 'FURROWRATE ', 'FLOODRATE '/) ,& SRC_ID = IRRIGATION(I) ,& DST_ID = CATCH(I) ,& RC = STATUS ) @@ -1540,7 +1545,8 @@ subroutine SetServices ( GC, RC ) if (RUN_IRRIG == 1) then call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'POROS ','WPWET ','VGWMAX ','WCRZ '/) ,& + SHORT_NAME = (/'POROS ', 'WPWET ' ,& + 'VGWMAX ', 'WCRZ '/) ,& SRC_ID = CATCH(I) ,& DST_ID = IRRIGATION(I) ,& RC=STATUS ) @@ -1548,7 +1554,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'SPRINKLERRATE','DRIPRATE ','FURROWRATE','FLOODRATE '/),& + SHORT_NAME = (/'SPRINKLERRATE', 'DRIPRATE ' ,& + 'FURROWRATE ', 'FLOODRATE '/) ,& SRC_ID = IRRIGATION(I) ,& DST_ID = CATCH(I) ,& RC=STATUS ) @@ -1567,15 +1574,15 @@ subroutine SetServices ( GC, RC ) ! ENDIF END SELECT - if (RUN_IRRIG == 1) then - call MAPL_AddConnectivity ( & - GC ,& - SHORT_NAME = (/'LAI '/) ,& - SRC_ID = VEGDYN ,& - DST_ID = IRRIGATION(I) ,& - RC=STATUS ) - VERIFY_(STATUS) - end if + if (RUN_IRRIG == 1) then + call MAPL_AddConnectivity ( & + GC ,& + SHORT_NAME = (/'LAI '/) ,& + SRC_ID = VEGDYN ,& + DST_ID = IRRIGATION(I) ,& + RC=STATUS ) + VERIFY_(STATUS) + end if END DO @@ -1591,8 +1598,8 @@ subroutine SetServices ( GC, RC ) call MAPL_GenericSetServices(GC, RC=STATUS ) VERIFY_(STATUS) - if (allocated(CATCH)) deallocate(CATCH) - if (allocated(CATCHCN)) deallocate(CATCHCN) + if (allocated(CATCH)) deallocate(CATCH) + if (allocated(CATCHCN)) deallocate(CATCHCN) if (allocated(IRRIGATION)) deallocate(IRRIGATION) RETURN_(ESMF_SUCCESS) @@ -1704,8 +1711,8 @@ subroutine Run1(GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code -! !DESCRIPTION: This first run method calls the children's -! first run methods. VEGDYN has only one, and it is called here. +! !DESCRIPTION: This first run method calls the children's first run methods. +! VEGDYN and Irrigation have only one run method, which is called here. !EOP ! ErrLog Variables diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index e6473a9c6..dacb8d152 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -746,38 +746,38 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'sprinkler_irrigation_rate' ,& - UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'SPRINKLERRATE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& + LONG_NAME = 'sprinkler_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'SPRINKLERRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'drip_irrigation_rate' ,& - UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'DRIPRATE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& + LONG_NAME = 'drip_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'DRIPRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'furrow_irrigation_rate' ,& - UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FURROWRATE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& + LONG_NAME = 'furrow_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FURROWRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'flood_irrigation_rate' ,& - UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FLOODRATE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& + LONG_NAME = 'flood_irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FLOODRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) @@ -3880,6 +3880,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ity real, dimension(:), pointer :: ASCATZ0 real, dimension(:), pointer :: NDVI + real, dimension(:), pointer :: SPRINKLERRATE real, dimension(:), pointer :: DRIPRATE real, dimension(:), pointer :: FURROWRATE @@ -4470,7 +4471,6 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,FURROWRATE, 'FURROWRATE' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,FLOODRATE, 'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) - ! ----------------------------------------------------- ! INTERNAL Pointers ! ----------------------------------------------------- @@ -5228,8 +5228,8 @@ subroutine Driver ( RC ) ! driver ! -------------------------------------------------------------------------- - _ASSERT(count(PLS<0.)==0,'needs informative message') - _ASSERT(count(PCU<0.)==0,'needs informative message') + _ASSERT(count(PLS <0.)==0,'needs informative message') + _ASSERT(count(PCU <0.)==0,'needs informative message') _ASSERT(count(SLDTOT<0.)==0,'needs informative message') LAI0 = max(0.0001 , LAI) @@ -5245,7 +5245,7 @@ subroutine Driver ( RC ) TILEZERO = 0.0 - PLS_IN = PLS + PLS_IN = PLS ! -------------------------------------------------------------------------- ! Add irrigation model imports @@ -5256,13 +5256,13 @@ subroutine Driver ( RC ) PLS_IN = PLS_IN + SPRINKLERRATE end where where (DRIPRATE > 0) - RZEXC = RZEXC + DRIPRATE*DT + RZEXC = RZEXC + DRIPRATE *DT end where where (FURROWRATE > 0) RZEXC = RZEXC + FURROWRATE*DT end where where (FLOODRATE > 0) - SRFEXC = SRFEXC + FLOODRATE*DT + SRFEXC = SRFEXC + FLOODRATE*DT end where endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 0af7cf765..0b9be56e8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -11,34 +11,31 @@ module GEOS_IrrigationGridCompMod ! !MODULE: GEOS_Irrigation -- child to the "Land" gridded component. !DESCRIPTION: -! {\tt GEOS\_Irrigation} is a gridded component that performs the -! necessary interpolation to provide refreshed values of the -! dynamic vegetation values prescribed by external data/observations.\\ +! {\tt GEOS\_Irrigation} is a gridded component that calculates +! irrigation rates that are (optionally) used in the Catchment[CN] model.\\ ! -! Exports from this routine are the instaneous values of the -! irrigation rates from 4 different irrigation methods on tilespace : +! Exports from this routine are the instantaneous values of the +! irrigation rates from 4 different irrigation methods on tilespace: ! 1) drip, 2) sprinkler, 3) furrow, and 4) flood. -! Because Land models (CATCH/CATCHCN) use -! irrigation rates as a water input in water budget calculation, -! All exports and imports are stored on the -! tile grid inherited from the parent routine.\\ +! Catchment[CN] (optionally) uses these irrigation rates as inputs to +! the water budget calculations. All imports and exports are stored +! in tile space. Soil parameters and root zone soil moisture are +! imports from the Catchment[CN] gridded component.\\ ! -! I. Parameter Class 1: Time and spatially dependent parameters -! from a binary data file\\ -! -! The gridded component stores the surrounding observations of -! each parameter in the internal state. All internals are static parameters. +! Temporally and spatially varying irrigation model parameters are +! from a binary data file.\\ +! +! All internals are static parameters.\\ +! +! IMPORTS: POROS, WPWET, VGWMAX, WCRZ, LAI\\ ! -! EXPORTS: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE\\ +! EXPORTS: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE\\ ! ! INTERNALS: IRRIGFRAC, PADDYFRAC, CROPIRRIGFRAC, IRRIGPLANT, IRRIGHARVEST, ! IRRIGTYPE, SPRINKLERFR, DRIPFR, FLOODFR, LAIMIN, LAIMAX\\ +! ! OPTIONAL INTERNALS: SRATE, DRATE, FRATE\\ ! -! This GC imports soil parameters and root zone soil moisture from land models -! to compute soil moisture state for IRRIGRATE calculation. -! IMPORTS: POROS, WPWET, VGWMAX, WCRZ, LAI \\ -! ! !USES: use ESMF @@ -75,7 +72,7 @@ subroutine SetServices ( GC, RC ) integer, optional :: RC ! return code ! !DESCRIPTION: This version uses the MAPL\_GenericSetServices. This function sets -! the Initialize and Finalize services, as well as allocating +! the Initialize and Finalize services, as well as allocating ! our instance of a generic state and putting it in the ! gridded component (GC). Here we only need to set the run method and ! add the state variable specifications (also generic) to our instance @@ -128,14 +125,17 @@ subroutine SetServices ( GC, RC ) ! Get runtime switches ! ----------------------------------------------------------- - call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) - SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) - call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) - call ESMF_ConfigGetAttribute (SCF, label='RUN_IRRIG:' , value=RUN_IRRIG , DEFAULT=0, __RC__ ) - call ESMF_ConfigGetAttribute (SCF, label='IRRIG_TRIGGER:', value=IRRIG_TRIGGER,DEFAULT=0, __RC__ ) - call ESMF_ConfigGetAttribute (SCF, label='IRRIG_METHOD:' , value=IRRIG_METHOD, DEFAULT=0, __RC__ ) + call MAPL_GetResource(MAPL, SURFRC, label='SURFRC:', default='GEOS_SurfaceGridComp.rc', RC=STATUS); VERIFY_(STATUS) + + SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) + + call ESMF_ConfigLoadFile( SCF, SURFRC, rc=status) ; VERIFY_(STATUS) + + call ESMF_ConfigGetAttribute(SCF, label='RUN_IRRIG:' , value=RUN_IRRIG , DEFAULT=0, __RC__ ) + call ESMF_ConfigGetAttribute(SCF, label='IRRIG_TRIGGER:', value=IRRIG_TRIGGER, DEFAULT=0, __RC__ ) + call ESMF_ConfigGetAttribute(SCF, label='IRRIG_METHOD:' , value=IRRIG_METHOD , DEFAULT=0, __RC__ ) - call ESMF_ConfigDestroy (SCF, __RC__) + call ESMF_ConfigDestroy (SCF, __RC__) ! Leave GEOSirrigation_GridComp if RUN_IRRIG == 0 if(RUN_IRRIG == 0) then @@ -146,9 +146,9 @@ subroutine SetServices ( GC, RC ) ! Set the the Initialize and Run entry point ! ----------------------------------------------------------- - call MAPL_GridCompSetEntryPoint (GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS ) + call MAPL_GridCompSetEntryPoint (GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS) VERIFY_(STATUS) - call MAPL_GridCompSetEntryPoint (GC, ESMF_METHOD_RUN, Run, RC=STATUS) + call MAPL_GridCompSetEntryPoint (GC, ESMF_METHOD_RUN, Run, RC=STATUS) VERIFY_(STATUS) ! BOS @@ -381,9 +381,9 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec(GC ,& - SHORT_NAME = 'FURROWRATE' ,& - LONG_NAME = 'furrow_irrigation_rate' ,& + call MAPL_AddExportSpec(GC ,& + SHORT_NAME = 'FURROWRATE' ,& + LONG_NAME = 'furrow_irrigation_rate' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -405,8 +405,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'POROS' ,& - LONG_NAME = 'soil_porosit' ,& - UNITS = '1' ,& + LONG_NAME = 'soil_porosity' ,& + UNITS = 'm3 m-3' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -497,14 +497,14 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm="Initialize" - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME + character(len=ESMF_MAXSTR) :: IAm="Initialize" + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME ! Locals - type (MAPL_MetaComp), pointer :: MAPL=>null() - type (ESMF_State ) :: INTERNAL + type (MAPL_MetaComp), pointer :: MAPL=>null() + type (ESMF_State ) :: INTERNAL ! INTERNAL pointers @@ -523,8 +523,8 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) real, dimension(:), pointer :: FURROWRATE real, dimension(:), pointer :: FLOODRATE - type(irrigation_model),pointer :: IM - type (IRRIG_wrap) :: wrap + type(irrigation_model), pointer :: IM + type (IRRIG_wrap) :: wrap ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- @@ -556,33 +556,37 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! get pointers to internal variables ! ---------------------------------- - call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC',RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! get pointers to EXPORT variable ! ------------------------------- - call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - ! Update IRRIGFRAC and PADDYFRAC for applications that are run on regular tiles in which IRRIGFRAC and PADDYFRAC in BCs are fractions. - ! The irrigation model would run on tiles whose IRRIGFRAC + PADDYFRAC > IRRIG_THRES (default is 0.01). + ! Update IRRIGFRAC and PADDYFRAC for applications that are run on regular tiles in + ! which IRRIGFRAC and PADDYFRAC in BCs are fractions. + ! The irrigation model would run on tiles with IRRIGFRAC + PADDYFRAC > IRRIG_THRES (default is 0.01). where (IRRIGFRAC + PADDYFRAC > IM%IRRIG_THRES) - !to assign the entire cell to the largest fraction remove comments below, - ! where (PADDYFRAC >= IRRIGFRAC) - ! PADDYFRAC = 1. - ! IRRIGFRAC = 0. - ! elsewhere - ! PADDYFRAC = 0. - ! IRRIGFRAC = 1. - ! endwhere + + ! uncomment the following block to assign the entire cell to the largest fraction: + + ! where (PADDYFRAC >= IRRIGFRAC) + ! PADDYFRAC = 1. + ! IRRIGFRAC = 0. + ! elsewhere + ! PADDYFRAC = 0. + ! IRRIGFRAC = 1. + ! endwhere + elsewhere PADDYFRAC = 0. IRRIGFRAC = 0. @@ -592,23 +596,22 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! LAI based trigger: scale soil moisture to LAI seasonal cycle ! ============================================================ - + call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & - IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) + IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) else - + ! crop calendar based irrigation ! ============================== call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & - CROPIRRIGFRAC,SRATE,DRATE,FRATE) + CROPIRRIGFRAC,SRATE,DRATE,FRATE) endif ! Scale computed SPRINKLERRATE, DRIPRATE, FURROWRATE, and FLOODRATE to the total - ! irrigated tile fraction before exporting to land models. - + ! irrigated tile fraction before exporting to Catchment[CN]. SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC) DRIPRATE = DRIPRATE *(IRRIGFRAC) @@ -637,14 +640,14 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME ! Locals - type (MAPL_MetaComp), pointer :: MAPL=>null() - type (ESMF_State ) :: INTERNAL + type (MAPL_MetaComp), pointer :: MAPL=>null() + type (ESMF_State ) :: INTERNAL ! INTERNAL pointers @@ -672,26 +675,25 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! IMPORT pointers - real, dimension(:), pointer :: POROS - real, dimension(:), pointer :: WPWET - real, dimension(:), pointer :: VGWMAX - real, dimension(:), pointer :: WCRZ - real, dimension(:), pointer :: LAI + real, dimension(:), pointer :: POROS + real, dimension(:), pointer :: WPWET + real, dimension(:), pointer :: VGWMAX + real, dimension(:), pointer :: WCRZ + real, dimension(:), pointer :: LAI ! Time attributes - type(ESMF_Time) :: CURRENT_TIME - integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr + type(ESMF_Time) :: CURRENT_TIME + integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr ! Others/ Locals - type(irrigation_model),pointer :: IM - type (IRRIG_wrap) :: wrap - real,pointer,dimension(:) :: lons - integer :: ntiles, n - real, dimension(:),allocatable :: local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF - real :: DT, T1, T2 - + type(irrigation_model), pointer :: IM + type (IRRIG_wrap) :: wrap + real, dimension(:), pointer :: lons + integer :: ntiles, n + real, dimension(:), allocatable :: local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF + real :: DT, T1, T2 ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- @@ -724,38 +726,38 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! get pointers to internal variables ! ---------------------------------- - call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC',RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGPLANT ,'IRRIGPLANT', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGHARVEST ,'IRRIGHARVEST', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, SPRINKLERFR ,'SPRINKLERFR', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, DRIPFR ,'DRIPFR', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, FLOODFR ,'FLOODFR', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LAIMIN ,'LAIMIN', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LAIMAX ,'LAIMAX', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGPLANT ,'IRRIGPLANT', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGHARVEST ,'IRRIGHARVEST', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, SPRINKLERFR ,'SPRINKLERFR', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, DRIPFR ,'DRIPFR', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, FLOODFR ,'FLOODFR', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, LAIMIN ,'LAIMIN', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, LAIMAX ,'LAIMAX', RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! get pointers to EXPORT variable ! ------------------------------- - call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! get pointers to IMPORT variables ! -------------------------------- - call MAPL_GetPointer(IMPORT, POROS , 'POROS', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, WPWET , 'WPWET', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, VGWMAX , 'VGWMAX', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, WCRZ , 'WCRZ', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, LAI , 'LAI', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, POROS , 'POROS', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, WPWET , 'WPWET', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, VGWMAX , 'VGWMAX', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, WCRZ , 'WCRZ', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, LAI , 'LAI', RC=STATUS) ; VERIFY_(STATUS) ! Get time and parameters from local state ! ---------------------------------------- @@ -791,8 +793,8 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) allocate (RZDEF (1:NTILES)) ! soil moisture state - SMWP = VGWMAX * WPWET ! RZ soil moisture content at wilting point [mm] - SMSAT = VGWMAX ! RZ soil moisture at saturation [mm] + SMWP = VGWMAX * WPWET ! RZ soil moisture content at wilting point [mm] + SMSAT = VGWMAX ! RZ soil moisture at saturation [mm] SMCNT = (VGWMAX/POROS) * WCRZ ! actual RZ soil moisture content [mm] DO N = 1, NTILES @@ -808,12 +810,14 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) local_hour(n) = real(NINT(local_hour(n))) end if - ! The reference soil moisture content is set to lower tercile of RZ soil moisture range [mm] to be consistent - ! with ASTRFR = 0.333 used in CATCH/CATCHCN. - ! Perhaps, soil field capacity (FIELDCAP) is the desired parameter here - the upper limit - ! of water content that soil can hold for plants after excess water drained off downward quickly. - ! If we want to switch to FIELDCAP in the future, that has already been derived on tiles and available - ! in irrigation_IMxJM_DL.dat file. + ! The reference soil moisture content is set to lower tercile of the root zone soil + ! moisture range [mm] to be consistent with ASTRFR = 0.333 used in Catchment[CN]. + ! + ! Note on choice of SMREF: + ! Perhaps, soil field capacity (FIELDCAP) is the desired parameter here - the upper limit + ! of water content that the soil can hold for plants after excess water drained off downward + ! quickly. In future, could switch to FIELDCAP, which has already been derived + ! on tiles and is available in the irrigation_IMxJM_DL.dat file. SMREF (n) = VGWMAX (n) * (wpwet (n) + (1. - wpwet (n))/ 3.) @@ -849,7 +853,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) endif ! Scale computed SPRINKLERRATE, DRIPRATE, FURROWRATE, and FLOODRATE to the total - ! irrigated tile fraction before exporting to land models. + ! irrigated tile fraction before exporting to Catchment[CN]. SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC) DRIPRATE = DRIPRATE *(IRRIGFRAC) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 30b47b959..f2635feef 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -6,99 +6,107 @@ MODULE IRRIGATION_MODULE USE ESMF IMPLICIT NONE + ! Irrigation Module + ! ! First Version: March 21, 2021 (Sarith Mahanama) ! Second Version: June 25, 2024 (Stefano Casirati) ! ! This module computes irrigation rates by 4 different methods: sprinkler, flood, furrow, and drip. - ! Computed irrigation rates return to the land model as rates that water is added to - ! the hydrological cycle by irrigation. Subsequently, land models add irrigation feedback: - ! 1) sprinkler irrigation rate to large scale precipitation (for irrigated tiles fractions); - ! 2) drip irrigation volume to rootzone excess (for irrigated tiles fractions); - ! 3) furrow irrigation volume to rootzone excess (for irrigated tiles fractions); - ! 4) flood irrigation volume to surface excess (only for paddy tiles fractions). - - ! The model uses rootzone soil moisture state at the local start time of irrigation to compute - ! irrigation rates for the day and maintains the same rate through out the irrigation duration. - ! - ! Sprinkler and Flood/Furrow Irrigation methods were adapted from LIS CLSMF2.5 irrigation module (Rodell et al., 2024 (Under Review) - ! Drip irrigation method calculation is similar to that of sprinkler, albeit the drip irrigation method assumes a 10% water loss. (Source FAO) + ! The computed irrigation rates (exports) are imports to Catchment[CN], where the irrigation water + ! is added to water balance as follows: + ! 1) sprinkler irrigation rate added to large scale precipitation (for irrigated tiles fractions); + ! 2) drip irrigation volume added to rootzone excess (for irrigated tiles fractions); + ! 3) furrow irrigation volume added to rootzone excess (for irrigated tiles fractions); + ! 4) flood irrigation volume added to surface excess (only for paddy tiles fractions). + + ! The model uses the rootzone soil moisture state at the local start time of irrigation to compute + ! irrigation rates for the day and maintains the same rate throughout the irrigation duration. ! + ! Sprinkler and Flood/Furrow Irrigation methods were adapted from LIS CLSMF2.5 irrigation module + ! (Rodell et al., 2024 (Under Review) + ! Drip irrigation method calculation is similar to that of sprinkler, albeit the drip irrigation + ! method assumes a 10% water loss. (Source FAO) ! ! (1) EXPORTS - MODEL OUTPUTS TO THE LAND MODEL (IRRIGATION RATES): - ! 1) SPRINKLERRATE [kg m-2 s-1] - ! 2) DRIPRATE [kg m-2 s-1] - ! 3) FURROWRATE [kg m-2 s-1] - ! 4) FLOODRATE [kg m-2 s-1] + ! 1) SPRINKLERRATE [kg m-2 s-1] + ! 2) DRIPRATE [kg m-2 s-1] + ! 3) FURROWRATE [kg m-2 s-1] + ! 4) FLOODRATE [kg m-2 s-1] ! ! (2) IRRIGATED AND PADDY TILES: ! During land BC's generation, the fraction of irrigated crops and paddy is set to zero ! if their sum is below an irrigation threshold (default 1%). ! Irrigated fractions can be irrigated with sprinkler, drip, and furrow, ! while paddy fractions can only be irrigated using the flood irrigation method. - ! Vegetation characteristics and vegetation dynamic parameters - ! for irrigated crops and paddy tiles were taken from the nearest grass or cropland tile. + ! Vegetation characteristics and vegetation dynamic parameters for irrigated + ! crops and paddy tiles were taken from the nearest grass or cropland tile. ! ! (3) MODEL INPUTS: - ! SMWP : rootzone soil moisture content at wilting point [mm] - ! SMSAT : rootzone soil moisture content at saturation [mm] - ! SMREF : rootzone soil moisture is at lower tercile of RZ soil moisture range [mm] - ! SMCNT : currrent root zone soil moisture content [mm] + ! SMWP : rootzone soil moisture content at wilting point [mm] + ! SMSAT : rootzone soil moisture content at saturation [mm] + ! SMREF : rootzone soil moisture is at lower tercile of RZ soil moisture range [mm] + ! SMCNT : currrent rootzone soil moisture content [mm] ! RZDEF : rootzone moisture deficit to reach complete soil saturation for paddy [mm] ! LOCAL_HOUR to set irrigation switch. ! ! (4) SEASONAL CYLCE OF CROP WATER DEMAND: - ! The module provides 2 options to determine the seasonal cycle of crop water demand: - ! 4.1) IRRIG_TRIGGER: 0 - SUBROUTINE irrigrate_lai_trigger + ! The module provides 2 options to determine the seasonal cycle of crop water demand: + ! 4.1) IRRIG_TRIGGER: 0 - SUBROUTINE irrigrate_lai_trigger ! The LAI-based trigger (Default and the current LIS implementation) ! uses precomputed minimum and maximum LAI on irrigateed pixels to determine ! beginning and end of crop growing seasons. ! - ! This LAI-based trigger is also equipped with an additional control parameter, IRRIG_METHOD, which is good to choose the method of irrigation - ! that woould run on corresponding fractions - ! i) 0: (Default) All 4 methods (sprinkler/furrow/flood/drip) concurrently. - ! ii) 1: Sprinkler irrigation on entire tile. - ! iv) 2: Drip irrigation on entire tile. - ! iii)3: Furrow/Flood irrigation on entire tile. + ! This LAI-based trigger is also equipped with an additional control parameter, IRRIG_METHOD, + ! which is good to choose the method of irrigation that would run on corresponding fraction: + ! i) 0: (Default) All 4 methods (sprinkler/furrow/flood/drip) concurrently. + ! ii) 1: Sprinkler irrigation on entire tile. + ! iv) 2: Drip irrigation on entire tile. + ! iii) 3: Furrow/Flood irrigation on entire tile. ! - ! IRRIG_TRIGGER: 0 SPECIFIC INPUTS: - ! IRRIGFRAC : fraction of tile covered by irrigated crops (values between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation - ! Threshold) - ! PADDYFRAC : fraction of tile covered by paddy (values between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation - ! Threshold) - ! SPRINKLERFR : fraction of tile equipped for sprinkler irrigation - ! DRIPFR : fraction of tile equipped for drip irrigation - ! FLOODFR : fraction of tile equipped for flood/furrow irrigation - ! LAI : time varying Leaf Area Index from the model - ! LAIMIN : Minimum LAI spatially averaged over the irrigated tile fraction - ! LAIMAX : Maximum LAI spatially averaged over the irrigated tile fraction + ! IRRIG_TRIGGER: 0 SPECIFIC INPUTS: + ! IRRIGFRAC : fraction of tile covered by irrigated crops; + ! ranges between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation Threshold) + ! PADDYFRAC : fraction of tile covered by paddy; + ! ranges between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation Threshold) + ! SPRINKLERFR : fraction of tile equipped for sprinkler irrigation + ! DRIPFR : fraction of tile equipped for drip irrigation + ! FLOODFR : fraction of tile equipped for flood/furrow irrigation + ! LAI : time varying Leaf Area Index from the model + ! LAIMIN : Minimum LAI spatially averaged over the irrigated tile fraction + ! LAIMAX : Maximum LAI spatially averaged over the irrigated tile fraction ! - ! 4.2) IRRIG_TRIGGER: 1 - SUBROUTINE irrigrate_crop_calendar - ! uses 26 crop calendars based on monthly crop growing areas of below crops. - ! 1 Wheat 14 Oil palm - ! 2 Maize 15 Rape seed / Canola - ! 3 Rice 16 Groundnuts / Peanuts - ! 4 Barley 17 Pulses - ! 5 Rye 18 Citrus - ! 6 Millet 19 Date palm - ! 7 Sorghum 20 Grapes / Vine - ! 8 Soybeans 21 Cotton - ! 9 Sunflower 22 Cocoa - ! 10 Potatoes 23 Coffee - ! 11 Cassava 24 Others perennial - ! 12 Sugar cane 25 Fodder grasses - ! 13 Sugar beet 26 Others annual + ! 4.2) IRRIG_TRIGGER: 1 - SUBROUTINE irrigrate_crop_calendar + ! Uses 26 crop calendars based on monthly crop growing areas of below crops. + ! 1 Wheat 14 Oil palm + ! 2 Maize 15 Rape seed / Canola + ! 3 Rice 16 Groundnuts / Peanuts + ! 4 Barley 17 Pulses + ! 5 Rye 18 Citrus + ! 6 Millet 19 Date palm + ! 7 Sorghum 20 Grapes / Vine + ! 8 Soybeans 21 Cotton + ! 9 Sunflower 22 Cocoa + ! 10 Potatoes 23 Coffee + ! 11 Cassava 24 Others perennial + ! 12 Sugar cane 25 Fodder grasses + ! 13 Sugar beet 26 Others annual ! - ! IRRIG_TRIGGER: 1 SPECIFIC INPUTS: - ! DOFYR : day of year - ! IRRIGTYPE : Preferred Irrig method (NTILES, 26) - - ! (0)CONCURRENT (default), (1)SPRINKLER ONLY (2)DRIP ONLY (3)FLOOD/FURROW ONLY, and (-negative) AVOID this method - ! CROPIRRIGFRAC: Crop irrigated fraction (NTILES, 26) (per Section 2, fractions have been adjusted such that - ! CROPIRRIGFRAC is 1. on paddy tiles; the sum of available crop fractions is 1. on irrigated crop tiles; - ! and is zero on non-irrigated tiles. - ! IRRIGPLANT : DOY start planting (NTILES, 2, 26) - up to two seasons - ! IRRIGHARVEST : DOY end harvesting (NTILES, 2, 26) - up to two seasons - ! If IRRIGPLANT/IRRIGHARVEST = 998, the crop is not grown on that tile + ! IRRIG_TRIGGER: 1 SPECIFIC INPUTS: + ! DOFYR : day of year + ! IRRIGTYPE : Preferred Irrig method (NTILES, 26) - + ! 0 CONCURRENT (default), + ! 1 SPRINKLER ONLY + ! 2 DRIP ONLY + ! 3 FLOOD/FURROW ONLY, and + ! <0 AVOID this method + ! CROPIRRIGFRAC: Crop irrigated fraction (NTILES, 26) (per Section 2, fractions have been + ! adjusted such that CROPIRRIGFRAC=1. on paddy tiles; the sum of available + ! crop fractions equals 1. on irrigated crop tiles; + ! and is zero on non-irrigated tiles. + ! IRRIGPLANT : DOY start planting (NTILES, 2, 26) - up to two seasons + ! IRRIGHARVEST : DOY end harvesting (NTILES, 2, 26) - up to two seasons + ! If IRRIGPLANT/IRRIGHARVEST = 998, the crop is not grown on that tile ! ! (5) MODEL UPDATES (OPTIONAL INTERNALS): ! SRATE, DRATE, and FRATE contain irrigation rates applied on individual fractions at any given time. @@ -116,27 +124,27 @@ MODULE IRRIGATION_MODULE ! Below parameters can be set via RC file. - REAL :: irrig_thres = 0.01 ! threshold of tile fraction to turn the irrigation model on. - REAL :: lai_thres = 0.6 ! threshold of LAI range to turn irrigation on - REAL :: efcor = 25.0 ! Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use) - REAL :: MIDS_LENGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER: 1) + REAL :: irrig_thres = 0.01 ! threshold of tile fraction to turn the irrigation model on. + REAL :: lai_thres = 0.6 ! threshold of LAI range to turn irrigation on + REAL :: efcor = 25.0 ! Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use) + REAL :: MIDS_LENGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER: 1) ! Sprinkler parameters ! -------------------- - REAL :: sprinkler_stime = 6.0 ! sprinkler irrigatrion start time [hours] - REAL :: sprinkler_dur = 4.0 ! sprinkler irrigation duration [hours] - REAL :: sprinkler_thres = 0.7 ! soil moisture threshhold to trigger sprinkler irrigation + REAL :: sprinkler_stime = 6.0 ! sprinkler irrigatrion start time [hours] + REAL :: sprinkler_dur = 4.0 ! sprinkler irrigation duration [hours] + REAL :: sprinkler_thres = 0.7 ! soil moisture threshhold to trigger sprinkler irrigation ! Drip parameters ! --------------- - REAL :: drip_stime = 8.0 ! drip irrigatrion start time [hours] - REAL :: drip_dur = 8.0 ! drip irrigation duration [hours] + REAL :: drip_stime = 8.0 ! drip irrigatrion start time [hours] + REAL :: drip_dur = 8.0 ! drip irrigation duration [hours] ! Flood parameters ! ---------------- - REAL :: flood_stime = 6.0 ! flood irrigatrion start time [hours] - REAL :: flood_dur = 8.0 ! flood irrigation duration [hours] - REAL :: flood_thres = 0.6 ! soil moisture threshhold to trigger flood irrigation + REAL :: flood_stime = 6.0 ! flood irrigatrion start time [hours] + REAL :: flood_dur = 8.0 ! flood irrigation duration [hours] + REAL :: flood_thres = 0.6 ! soil moisture threshhold to trigger flood irrigation end type irrig_params @@ -230,7 +238,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & CHECK_IRRIGFRACS: IF ((IRRIGFRAC(N) > 0.).OR.(PADDYFRAC(N)>0.)) THEN !----------------------------------------------------------------------------- - ! Get the root zone moisture availability to the plant + ! Get the rootzone moisture availability to the plant !----------------------------------------------------------------------------- if (IRRIGFRAC(N) > 0.) then if(SMREF(N) > SMWP(N))then From 853f1cdb9204d8a5d7d8048d6e543d850ebd73e7 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 25 Sep 2024 16:53:14 -0400 Subject: [PATCH 22/55] fixed error in manual conflict resolution from most recent merge of develop (GEOS_CatchGridComp.F90) --- .../GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index dacb8d152..f9eac5430 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5700,7 +5700,7 @@ subroutine Driver ( RC ) DT,CATCH_INTERNAL_STATE%USE_FWET_FOR_RUNOFF ,& CATCH_INTERNAL_STATE%FWETC, CATCH_INTERNAL_STATE%FWETL,& cat_id, VEG, DZSF_in_mm ,& ! cat_id is set to no-data above !!! - PCU , PLS , SNO, ICE, FRZR ,& + PCU , PLS_IN , SNO, ICE, FRZR ,& UUU ,& EVSBT(:,FSAT), DEVSBT(:,FSAT), DEDTC(:,FSAT) ,& From 13c4501ffe3967623bce9972cfc9efdadb00de42 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Mon, 30 Sep 2024 17:06:59 -0400 Subject: [PATCH 23/55] additional minor edits of comments and whitespace cleanup (GEOS_LandGridComp.F90) --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 61 ++++++++++--------- 1 file changed, 33 insertions(+), 28 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 55c3f4935..6bb96aaca 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -16,11 +16,12 @@ module GEOS_LandGridCompMod ! Furthermore, several exports of the Vegdyn routines are also exports ! from the Land composite, for use in other modules. For example, ! lai and grn are needed in radiation. Vegdyn will be updated first. -! Then the catchment call will be issued. IrrigationGridComp -! was added to compute the irrigation rate IMPORT required by land models. +! Then the Catch[CN] Phase=1 call will be issued. IrrigationGridComp +! computes the irrigation rate IMPORT required by Catch[CN], +! followed by Catch[CN] Phase=2 (incl. application of irrigation). ! The composite exports consist of the union of the catchment exports with a -! subset of the vegdyn exports. All imports and exports are on the prescribed -! tile grid in the (IM, JM)=(NTILES, 1) convention. +! subset of the vegdyn and Irrigation exports. All imports and exports are +! on the prescribed tile grid in the (IM, JM)=(NTILES, 1) convention. ! ! !USES: @@ -67,7 +68,7 @@ subroutine SetServices ( GC, RC ) type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component integer, optional :: RC ! return code -! !DESCRIPTION: The SetServices for the Physics GC needs to register its +! !DESCRIPTION: The SetServices for the Land GC needs to register its ! Initialize and Run. It uses the MAPL\_Generic construct for defining ! state specs and couplings among its children. In addition, it creates the ! children GCs (VegDyn, Catch, CatchCN, Irrigation, Route) and runs their @@ -105,7 +106,7 @@ subroutine SetServices ( GC, RC ) call ESMF_GridCompGet(GC ,& NAME=COMP_NAME ,& CONFIG=CF ,& - RC=STATUS ) + RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // 'SetServices' @@ -117,7 +118,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_GetResource ( MAPL, NUM_LDAS_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) + call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) tmp = '' @@ -132,9 +133,9 @@ subroutine SetServices ( GC, RC ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS ) VERIFY_(STATUS) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run1, RC=STATUS ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run1, RC=STATUS ) VERIFY_(STATUS) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run2, RC=STATUS ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run2, RC=STATUS ) VERIFY_(STATUS) call ESMF_ConfigGetAttribute ( CF, NUM_CATCH, Label="NUM_CATCH_ENSEMBLES:", default=1, RC=STATUS) @@ -152,15 +153,19 @@ subroutine SetServices ( GC, RC ) ! and Runoff Routing Model (0: OFF, 1: ON) ! ------------------------------------------------------- - call MAPL_GetResource ( MAPL, LSM_CHOICE, Label="LSM_CHOICE:", DEFAULT=1, RC=STATUS) + call MAPL_GetResource (MAPL, LSM_CHOICE, Label="LSM_CHOICE:", DEFAULT=1, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) - SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) + call MAPL_GetResource (MAPL, SURFRC, Label = 'SURFRC:', DEFAULT='GEOS_SurfaceGridComp.rc', RC=STATUS) + VERIFY_(STATUS) + + SCF = ESMF_ConfigCreate( rc=status) ; VERIFY_(STATUS) call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) + call MAPL_GetResource (SCF, RUN_ROUTE, label='RUN_ROUTE:', DEFAULT=0, __RC__ ) call MAPL_GetResource (SCF, RUN_IRRIG, label='RUN_IRRIG:', DEFAULT=0, __RC__ ) call MAPL_GetResource (SCF, DO_GOSWIM, label='N_CONST_LAND4SNWALB:', DEFAULT=0, __RC__ ) call MAPL_GetResource (SCF, DO_FIRE_DANGER, label='FIRE_DANGER:', DEFAULT=.false., __RC__ ) + call ESMF_ConfigDestroy(SCF, __RC__) SELECT CASE (LSM_CHOICE) @@ -1638,14 +1643,14 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Local derived type aliases - type (MAPL_MetaComp ), pointer :: MAPL - type (MAPL_MetaComp ), pointer :: CHILD_MAPL - type (MAPL_LocStream ) :: LOCSTREAM - type (ESMF_DELayout ) :: LAYOUT - type (ESMF_Config ) :: CF - type (ESMF_GridComp ), pointer :: GCS(:) + type (MAPL_MetaComp ), pointer :: MAPL + type (MAPL_MetaComp ), pointer :: CHILD_MAPL + type (MAPL_LocStream ) :: LOCSTREAM + type (ESMF_DELayout ) :: LAYOUT + type (ESMF_Config ) :: CF + type (ESMF_GridComp ), pointer :: GCS(:) - integer :: I + integer :: I !============================================================================= @@ -1665,7 +1670,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) call MAPL_TimerOn(MAPL,"INITIALIZE", RC=STATUS ); VERIFY_(STATUS) - call MAPL_TimerOn(MAPL,"TOTAL", RC=STATUS ); VERIFY_(STATUS) + call MAPL_TimerOn(MAPL,"TOTAL", RC=STATUS ); VERIFY_(STATUS) ! Get the land tilegrid and the child components !----------------------------------------------- @@ -1748,13 +1753,13 @@ subroutine Run1(GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) call MAPL_TimerOn(MAPL,"TOTAL", RC=STATUS ); VERIFY_(STATUS) - call MAPL_TimerOn(MAPL,"RUN1", RC=STATUS ); VERIFY_(STATUS) + call MAPL_TimerOn(MAPL,"RUN1", RC=STATUS ); VERIFY_(STATUS) call MAPL_Get (MAPL, GCS=GCS, GIM=GIM, GEX=GEX, GCnames=GCnames,rc=STATUS) VERIFY_(STATUS) -! Call the children's RUN methods -!-------------------------------- +! Call the children's RUN methods (PHASE=1) +!------------------------------------------ DO I = 1, size(GCS) call MAPL_TimerOn(MAPL,trim(GCnames(i)), RC=STATUS ); VERIFY_(STATUS) @@ -1764,7 +1769,7 @@ subroutine Run1(GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_TimerOff(MAPL,trim(GCnames(i)), RC=STATUS ); VERIFY_(STATUS) END DO - call MAPL_TimerOff(MAPL,"RUN1", RC=STATUS ); VERIFY_(STATUS) + call MAPL_TimerOff(MAPL,"RUN1", RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"TOTAL", RC=STATUS ); VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) @@ -1822,13 +1827,13 @@ subroutine Run2(GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) call MAPL_TimerOn(MAPL,"TOTAL", RC=STATUS ); VERIFY_(STATUS) - call MAPL_TimerOn(MAPL,"RUN2", RC=STATUS ); VERIFY_(STATUS) + call MAPL_TimerOn(MAPL,"RUN2", RC=STATUS ); VERIFY_(STATUS) call MAPL_Get (MAPL, GCS=GCS, GIM=GIM, GEX=GEX, GCnames=GCnames,rc=STATUS) VERIFY_(STATUS) -! Call the children's RUN methods -!-------------------------------- +! Call the children's RUN methods (PHASE=2) +!------------------------------------------ DO I=1,size(GCS) if (I == VEGDYN) cycle call MAPL_TimerOn(MAPL,trim(GCnames(i)), RC=STATUS ); VERIFY_(STATUS) @@ -1838,7 +1843,7 @@ subroutine Run2(GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_TimerOff(MAPL,trim(GCnames(i)), RC=STATUS ); VERIFY_(STATUS) END DO - call MAPL_TimerOff(MAPL,"RUN2", RC=STATUS ); VERIFY_(STATUS) + call MAPL_TimerOff(MAPL,"RUN2", RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"TOTAL", RC=STATUS ); VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) From 04b390dca25ada52e4d9faa5a5108e84091ec001 Mon Sep 17 00:00:00 2001 From: stefanocasirati Date: Mon, 14 Oct 2024 16:38:57 -0700 Subject: [PATCH 24/55] Addressed some of the comments and fixed a bug --- .../irrigation_model.F90 | 8 +++---- .../Shared/GEOS_SurfaceGridComp.rc | 24 +++++++++---------- .../Raster/makebcs/make_bcs_questionary.py | 2 +- .../Raster/makebcs/rmTinyCatchParaMod.F90 | 5 ++-- 4 files changed, 19 insertions(+), 20 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index f2635feef..013de351b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -207,7 +207,7 @@ END SUBROUTINE init_model SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN,LAIMAX, RZDEF, & - SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE, SRATE, DRATE, FRATE) + SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, SRATE, DRATE, FRATE) implicit none class (irrigation_model), intent(inout) :: this @@ -329,7 +329,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & ! Update SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE EXPORTS to be sent to land models. ! FLOODRATE is weighted averaged over irrigated crops + paddy fractions. - call this%update_irates (SPRINKLERRATE,DRIPRATE,FURROWRATE,FLOODRATE, & + call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, FURROWRATE, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) END SUBROUTINE irrigrate_lai_trigger @@ -340,7 +340,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & SPRINKLERFR, DRIPFR, FLOODFR, & CROPIRRIGFRAC,IRRIGPLANT, IRRIGHARVEST, IRRIGTYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - SPRINKLERRATE, DRIPRATE,FURROWRATE, FLOODRATE, SRATE, DRATE, FRATE) + SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, SRATE, DRATE, FRATE) implicit none class(irrigation_model),intent(inout):: this @@ -483,7 +483,7 @@ END SUBROUTINE irrigrate_crop_calendar ! ---------------------------------------------------------------------------- - SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FURROWRATE,FLOODRATE, & + SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, FURROWRATE, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc index 87626d002..5f3894bae 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc @@ -190,18 +190,18 @@ # # ----- Below default parameter values can also be changed via this resource file: # -# IRRIG_THRES: 0.5 # threshold of tile fraction to turn the irrigation model on. -# LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on -# SPRINKLER_STIME: 6.0 # sprinkler irrigatrion start time [hours] -# SPRINKLER_DUR: 4.0 # sprinkler irrigation duration [hours] -# SPRINKLER_THRES: 0.7 # soil moisture threshhold to trigger sprinkler irrigation -# DRIP_STIME: 8.0 # drip irrigatrion start time [hours] -# DRIP_DUR: 8.0 # drip irrigation duration [hours] -# FLOOD_STIME: 6.0 # flood irrigatrion start time [hours] -# FLOOD_DUR: 1.0 # flood irrigation duration [hours] -# FLOOD_THRES: 0.6 # soil moisture threshhold to trigger flood irrigation -# IRR_EFCOR: 30.0 # Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use ) -# MIDS_LENGTH: 0.6 # Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER : 1) +# GEOSldas=>IRRIG_THRES: 0.01 # threshold of tile fraction to turn the irrigation model on. +# GEOSldas=>LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on +# GEOSldas=>SPRINKLER_STIME: 6.0 # sprinkler irrigatrion start time [hours] +# GEOSldas=>SPRINKLER_DUR: 4.0 # sprinkler irrigation duration [hours] +# GEOSldas=>SPRINKLER_THRES: 0.7 # soil moisture threshhold to trigger sprinkler irrigation +# GEOSldas=>DRIP_STIME: 8.0 # drip irrigatrion start time [hours] +# GEOSldas=>DRIP_DUR: 8.0 # drip irrigation duration [hours] +# GEOSldas=>FLOOD_STIME: 6.0 # flood irrigatrion start time [hours] +# GEOSldas=>FLOOD_DUR: 8.0 # flood irrigation duration [hours] +# GEOSldas=>FLOOD_THRES: 0.7 # soil moisture threshhold to trigger flood irrigation +# GEOSldas=>IRR_EFCOR: 25.0 # Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use ) +# GEOSldas=>MIDS_LENGTH: 0.6 # Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER : 1) # # lengths of development and end seasons are assumed as (1 - MIDS_LENGTH) / 2. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py index a37accf8b..a47b7a535 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_questionary.py @@ -195,7 +195,7 @@ def ask_questions(default_grid="Cubed-Sphere"): "v10 : NL3 + PEATMAP + MODIS snow alb v2", \ "v11 : NL3 + JPL veg height + PEATMAP + MODIS snow alb v2", \ "v12 : NL3 + JPL veg height + PEATMAP + MODIS snow alb v2 + Argentina peatland fix", \ - "v13 : NL3 + JPL veg height + PEATMAP + MODIS snow alb v2 + Irrigation", \ + "v13 : NL3 + JPL veg height + PEATMAP + MODIS snow alb v2 + Argentina peatland fix + Irrigation", \ "ICA : Icarus (archived*: /discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Icarus/)", \ "GM4 : Ganymed-4_0 (archived*: /discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Ganymed-4_0/)", \ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 index 906290978..6f853606a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 @@ -228,16 +228,15 @@ SUBROUTINE init_bcs_config (LBCSV) case ("v13") LAIBCS = 'MODGEO' - SOILBCS = 'HWSD' + SOILBCS = 'HWSD_b' MODALB = 'MODIS2' SNOWALB = 'MODC061v2' + OUTLETV = "v2" GNU = 1.0 use_PEATMAP = .true. jpl_height = .true. IRRIGBCS = .true. - - case default print *,'init_bcs_config(): unknown land boundary conditions version (LBCSV)' From cffeaeb4f0ac11b92f9a544dd1e4fbed4fec7517 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Mon, 16 Dec 2024 14:31:53 -0500 Subject: [PATCH 25/55] added minor comment (GEOS_LandGridComp.F90) --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 6bb96aaca..b190c719b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -202,7 +202,7 @@ subroutine SetServices ( GC, RC ) end do end if - END SELECT + END SELECT ! LSM_CHOICE if(RUN_IRRIG==1) then allocate (IRRIGATION(NUM_CATCH), stat=status) @@ -1381,7 +1381,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'ROC002', CHILD_ID = CATCHCN(1), RC=STATUS) ; VERIFY_(STATUS) endif - END SELECT + END SELECT ! LSM_CHOICE (Catch, CatchCN) if (RUN_IRRIG == 1) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPRINKLERRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) From 9486c7d5c5c7f31c564ef598dd5dd25ad3c4398f Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Mon, 3 Feb 2025 16:54:38 -0500 Subject: [PATCH 26/55] (tentatively) renamed irrigation exports --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 20 ++--- .../GEOS_CatchCNGridComp.F90 | 18 ++-- .../GEOS_CatchCNCLM40GridComp.F90 | 60 ++++++------- .../GEOS_CatchCNCLM45GridComp.F90 | 60 ++++++------- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 60 ++++++------- .../GEOS_IrrigationGridComp.F90 | 90 +++++++++---------- .../irrigation_model.F90 | 73 +++++++-------- 7 files changed, 192 insertions(+), 189 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index b190c719b..3829a1a5d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -556,7 +556,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, & - SHORT_NAME = 'IRRLAND', & + SHORT_NAME = 'IRRG_RATE_TOT', & CHILD_ID = CATCH(1), & RC=STATUS ) VERIFY_(STATUS) @@ -1122,7 +1122,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'PRLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRLAND', CHILD_ID = CATCHCN(1), RC=STATUS ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_TOT', CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SNOLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) @@ -1384,10 +1384,10 @@ subroutine SetServices ( GC, RC ) END SELECT ! LSM_CHOICE (Catch, CatchCN) if (RUN_IRRIG == 1) then - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPRINKLERRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FLOODRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FURROWRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRIPRATE', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_SPR', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_PDY', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_FRW', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_DRP', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) end if @@ -1506,8 +1506,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'SPRINKLERRATE', 'DRIPRATE ' ,& - 'FURROWRATE ', 'FLOODRATE '/) ,& + SHORT_NAME = (/'IRRG_RATE_SPR', 'IRRG_RATE_DRP' ,& + 'IRRG_RATE_FRW', 'IRRG_RATE_PDY'/) ,& SRC_ID = IRRIGATION(I) ,& DST_ID = CATCH(I) ,& RC = STATUS ) @@ -1559,8 +1559,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddConnectivity ( & GC ,& - SHORT_NAME = (/'SPRINKLERRATE', 'DRIPRATE ' ,& - 'FURROWRATE ', 'FLOODRATE '/) ,& + SHORT_NAME = (/'IRRG_RATE_SPR', 'IRRG_RATE_DRP' ,& + 'IRRG_RATE_FRW', 'IRRG_RATE_PDY'/) ,& SRC_ID = IRRIGATION(I) ,& DST_ID = CATCH(I) ,& RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 883d8de56..3573f7f85 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -672,8 +672,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'SPRINKLERRATE' ,& - LONG_NAME = 'sprinkler_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_SPR' ,& + LONG_NAME = 'irrigation_flux_sprinkler' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -681,8 +681,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'DRIPRATE' ,& - LONG_NAME = 'drip_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_DRP' ,& + LONG_NAME = 'irrigation_flux_drip' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -690,8 +690,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'FURROWRATE' ,& - LONG_NAME = 'furrow_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_FRW' ,& + LONG_NAME = 'irrigation_flux_furrow' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -699,8 +699,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'FLOODRATE' ,& - LONG_NAME = 'flood_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_PDY' ,& + LONG_NAME = 'irrigation_flux_paddy' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -826,7 +826,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'PRLAND' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRLAND' , CHILD_ID = CATCHCN, RC=STATUS ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_TOT' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SNOLAND' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 54d6278b5..19fe328f0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -771,8 +771,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'SPRINKLERRATE' ,& - LONG_NAME = 'sprinkler_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_SPR' ,& + LONG_NAME = 'irrigation_flux_sprinkler' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -780,8 +780,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'DRIPRATE' ,& - LONG_NAME = 'drip_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_DRP' ,& + LONG_NAME = 'irrigation_flux_drip' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -789,8 +789,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'FURROWRATE' ,& - LONG_NAME = 'furrow_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_FRW' ,& + LONG_NAME = 'irrigation_flux_furrow' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -798,8 +798,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'FLOODRATE' ,& - LONG_NAME = 'flood_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_PDY' ,& + LONG_NAME = 'irrigation_flux_paddy' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -2879,8 +2879,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'IRRLAND', & - LONG_NAME = 'Total_irrigation_land', & + SHORT_NAME = 'IRRG_RATE_TOT', & + LONG_NAME = 'irrigation_flux_total', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -4527,10 +4527,10 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: GRN real, dimension(:), pointer :: ASCATZ0 real, dimension(:), pointer :: NDVI - real, dimension(:), pointer :: SPRINKLERRATE - real, dimension(:), pointer :: DRIPRATE - real, dimension(:), pointer :: FURROWRATE - real, dimension(:), pointer :: FLOODRATE + real, dimension(:), pointer :: IRRG_RATE_SPR + real, dimension(:), pointer :: IRRG_RATE_DRP + real, dimension(:), pointer :: IRRG_RATE_FRW + real, dimension(:), pointer :: IRRG_RATE_PDY real, dimension(:,:), pointer :: DUDP real, dimension(:,:), pointer :: DUSV real, dimension(:,:), pointer :: DUWT @@ -4716,7 +4716,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND - real, dimension(:), pointer :: IRRLAND + real, dimension(:), pointer :: IRRG_RATE_TOT real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -5185,10 +5185,10 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSSV ,'SSSV' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSWT ,'SSWT' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DRIPRATE,'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,FLOODRATE,'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,FURROWRATE,'FURROWRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_SPR,'IRRG_RATE_SPR',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_DRP,'IRRG_RATE_DRP',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_PDY,'IRRG_RATE_PDY',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_FRW,'IRRG_RATE_FRW',RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- ! INTERNAL Pointers @@ -5357,7 +5357,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP, 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND, 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND, 'PRLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IRRLAND,'IRRLAND', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IRRG_RATE_TOT,'IRRG_RATE_TOT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND, 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND, 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND, 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -6965,17 +6965,17 @@ subroutine Driver ( RC ) ! -------------------------------------------------------------------------- IF ((catchcn_internal%RUN_IRRIG /= 0)) THEN - where (SPRINKLERRATE > 0) - PLS_IN = PLS_IN + SPRINKLERRATE + where (IRRG_RATE_SPR > 0) + PLS_IN = PLS_IN + IRRG_RATE_SPR end where - where (DRIPRATE > 0) - RZEXC = RZEXC + DRIPRATE*DT + where (IRRG_RATE_DRP > 0) + RZEXC = RZEXC + IRRG_RATE_DRP * DT end where - where (FLOODRATE > 0) - SRFEXC = SRFEXC + FLOODRATE*DT + where (IRRG_RATE_PDY > 0) + SRFEXC = SRFEXC + IRRG_RATE_PDY * DT end where - where (FURROWRATE > 0) - RZEXC = RZEXC + FURROWRATE*DT + where (IRRG_RATE_FRW > 0) + RZEXC = RZEXC + IRRG_RATE_FRW * DT end where ENDIF #ifdef DBG_CNLSM_INPUTS @@ -7397,8 +7397,8 @@ subroutine Driver ( RC ) if(associated( WCPR )) WCPR = PRMC if(associated( ACCUM)) ACCUM = SLDTOT - EVPICE*(1./MAPL_ALHS) - SMELT if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT - if(associated(IRRLAND)) then - if (catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FURROWRATE + FLOODRATE + DRIPRATE + if(associated(IRRG_RATE_TOT)) then + if (catchcn_internal%RUN_IRRIG /= 0) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW + IRRG_RATE_PDY + IRRG_RATE_DRP endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(EVPSNO)) EVPSNO = EVPICE diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 383d1217a..168718e2b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -774,8 +774,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'SPRINKLERRATE' ,& - LONG_NAME = 'sprinkler_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_SPR' ,& + LONG_NAME = 'irrigation_flux_sprinkler' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -783,8 +783,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'DRIPRATE' ,& - LONG_NAME = 'drip_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_DRP' ,& + LONG_NAME = 'irrigation_flux_drip' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -792,8 +792,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'FURROWRATE' ,& - LONG_NAME = 'furrow_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_FRW' ,& + LONG_NAME = 'irrigation_flux_furrow' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -801,8 +801,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'FLOODRATE' ,& - LONG_NAME = 'flood_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_PDY' ,& + LONG_NAME = 'irrigation_flux_paddy' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -2814,8 +2814,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'IRRLAND', & - LONG_NAME = 'Total_irrigation_land', & + SHORT_NAME = 'IRRG_RATE_TOT', & + LONG_NAME = 'irrigation_flux_total', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -4492,10 +4492,10 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ASCATZ0 real, dimension(:), pointer :: NDVI - real, dimension(:), pointer :: SPRINKLERRATE - real, dimension(:), pointer :: DRIPRATE - real, dimension(:), pointer :: FURROWRATE - real, dimension(:), pointer :: FLOODRATE + real, dimension(:), pointer :: IRRG_RATE_SPR + real, dimension(:), pointer :: IRRG_RATE_DRP + real, dimension(:), pointer :: IRRG_RATE_FRW + real, dimension(:), pointer :: IRRG_RATE_PDY real, dimension(:,:), pointer :: DUDP real, dimension(:,:), pointer :: DUSV @@ -4698,7 +4698,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND - real, dimension(:), pointer :: IRRLAND + real, dimension(:), pointer :: IRRG_RATE_TOT real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -5206,10 +5206,10 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSSV ,'SSSV' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSWT ,'SSWT' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DRIPRATE, 'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,FURROWRATE, 'FURROWRATE' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,FLOODRATE, 'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_SPR,'IRRG_RATE_SPR',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_DRP,'IRRG_RATE_DRP',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_FRW,'IRRG_RATE_FRW',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_PDY,'IRRG_RATE_PDY',RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- ! INTERNAL Pointers @@ -5395,7 +5395,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP , 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND , 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND , 'PRLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IRRLAND , 'IRRLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IRRG_RATE_TOT , 'IRRG_RATE_TOT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND , 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND , 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND , 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -7248,17 +7248,17 @@ subroutine Driver ( RC ) ! -------------------------------------------------------------------------- IF (catchcn_internal%RUN_IRRIG /= 0) THEN - where (SPRINKLERRATE > 0) - PLS_IN = PLS_IN + SPRINKLERRATE + where (IRRG_RATE_SPR > 0) + PLS_IN = PLS_IN + IRRG_RATE_SPR end where - where (DRIPRATE > 0) - RZEXC = RZEXC + DRIPRATE*DT + where (IRRG_RATE_DRP > 0) + RZEXC = RZEXC + IRRG_RATE_DRP * DT end where - where (FLOODRATE > 0) - SRFEXC = SRFEXC + FLOODRATE*DT + where (IRRG_RATE_PDY > 0) + SRFEXC = SRFEXC + IRRG_RATE_PDY * DT end where - where (FURROWRATE > 0) - RZEXC = RZEXC + FURROWRATE*DT + where (IRRG_RATE_FRW > 0) + RZEXC = RZEXC + IRRG_RATE_FRW * DT end where ENDIF @@ -7684,8 +7684,8 @@ subroutine Driver ( RC ) if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT - if(associated(IRRLAND)) then - if(catchcn_internal%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FURROWRATE + FLOODRATE + DRIPRATE + if(associated(IRRG_RATE_TOT)) then + if(catchcn_internal%RUN_IRRIG /= 0) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW + IRRG_RATE_PDY + IRRG_RATE_DRP endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(DRPARLAND)) DRPARLAND = DRPAR diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 009540907..d620a05c7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -746,36 +746,36 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'sprinkler_irrigation_rate' ,& + LONG_NAME = 'irrigation_flux_sprinkler' ,& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'SPRINKLERRATE' ,& + SHORT_NAME = 'IRRG_RATE_SPR' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'drip_irrigation_rate' ,& + LONG_NAME = 'irrigation_flux_drip' ,& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'DRIPRATE' ,& + SHORT_NAME = 'IRRG_RATE_DRP' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'furrow_irrigation_rate' ,& + LONG_NAME = 'irrigation_flux_furrow' ,& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FURROWRATE' ,& + SHORT_NAME = 'IRRG_RATE_FRW' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'flood_irrigation_rate' ,& + LONG_NAME = 'irrigation_flux_paddy' ,& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FLOODRATE' ,& + SHORT_NAME = 'IRRG_RATE_PDY' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -2376,8 +2376,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'IRRLAND', & - LONG_NAME = 'Total_irrigation_land', & + SHORT_NAME = 'IRRG_RATE_TOT', & + LONG_NAME = 'irrigation_flux_total', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3881,10 +3881,10 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ASCATZ0 real, dimension(:), pointer :: NDVI - real, dimension(:), pointer :: SPRINKLERRATE - real, dimension(:), pointer :: DRIPRATE - real, dimension(:), pointer :: FURROWRATE - real, dimension(:), pointer :: FLOODRATE + real, dimension(:), pointer :: IRRG_RATE_SPR + real, dimension(:), pointer :: IRRG_RATE_DRP + real, dimension(:), pointer :: IRRG_RATE_FRW + real, dimension(:), pointer :: IRRG_RATE_PDY real, dimension(:,:), pointer :: DUDP real, dimension(:,:), pointer :: DUSV @@ -4048,7 +4048,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND - real, dimension(:), pointer :: IRRLAND + real, dimension(:), pointer :: IRRG_RATE_TOT real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -4466,10 +4466,10 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSWT ,'SSWT' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,SPRINKLERRATE,'SPRINKLERRATE',RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DRIPRATE, 'DRIPRATE' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,FURROWRATE, 'FURROWRATE' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,FLOODRATE, 'FLOODRATE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_SPR,'IRRG_RATE_SPR',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_DRP,'IRRG_RATE_DRP',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_FRW,'IRRG_RATE_FRW',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_PDY,'IRRG_RATE_PDY',RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- ! INTERNAL Pointers @@ -4613,7 +4613,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP, 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND, 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND, 'PRLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IRRLAND,'IRRLAND', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IRRG_RATE_TOT,'IRRG_RATE_TOT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND, 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND, 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND, 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -5252,17 +5252,17 @@ subroutine Driver ( RC ) ! -------------------------------------------------------------------------- if(CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) then - where (SPRINKLERRATE > 0) - PLS_IN = PLS_IN + SPRINKLERRATE + where (IRRG_RATE_SPR > 0) + PLS_IN = PLS_IN + IRRG_RATE_SPR end where - where (DRIPRATE > 0) - RZEXC = RZEXC + DRIPRATE *DT + where (IRRG_RATE_DRP > 0) + RZEXC = RZEXC + IRRG_RATE_DRP * DT end where - where (FURROWRATE > 0) - RZEXC = RZEXC + FURROWRATE*DT + where (IRRG_RATE_FRW > 0) + RZEXC = RZEXC + IRRG_RATE_FRW * DT end where - where (FLOODRATE > 0) - SRFEXC = SRFEXC + FLOODRATE*DT + where (IRRG_RATE_PDY > 0) + SRFEXC = SRFEXC + IRRG_RATE_PDY * DT end where endif @@ -5904,8 +5904,8 @@ subroutine Driver ( RC ) if(associated(EVPSNO)) EVPSNO = EVPICE if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT - if(associated(IRRLAND)) then - if (CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) IRRLAND = SPRINKLERRATE + FURROWRATE +FLOODRATE + DRIPRATE + if(associated(IRRG_RATE_TOT)) then + if (CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW +IRRG_RATE_PDY + IRRG_RATE_DRP endif if(associated(SNOLAND)) SNOLAND = SLDTOT ! note, not just SNO if(associated(DRPARLAND)) DRPARLAND = DRPAR diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 0b9be56e8..a8354d6be 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -29,7 +29,7 @@ module GEOS_IrrigationGridCompMod ! ! IMPORTS: POROS, WPWET, VGWMAX, WCRZ, LAI\\ ! -! EXPORTS: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE\\ +! EXPORTS: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY\\ ! ! INTERNALS: IRRIGFRAC, PADDYFRAC, CROPIRRIGFRAC, IRRIGPLANT, IRRIGHARVEST, ! IRRIGTYPE, SPRINKLERFR, DRIPFR, FLOODFR, LAIMIN, LAIMAX\\ @@ -285,7 +285,7 @@ subroutine SetServices ( GC, RC ) ! only two crop types: irrigated crops and paddy in that order. call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'SRATE' ,& - LONG_NAME ='crop_specific_sprinkler_irrigation_rate',& + LONG_NAME ='crop_specific_irrigation_flux_sprinkler',& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -297,7 +297,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'DRATE' ,& - LONG_NAME = 'crop_specific_drip_irrigation_rate' ,& + LONG_NAME = 'crop_specific_irrigation_flux_drip' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -309,7 +309,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'FRATE' ,& - LONG_NAME = 'crop_specific_flood_irrigation_rate' ,& + LONG_NAME = 'crop_specific_irrigation_flux_paddy' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -323,7 +323,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'SRATE' ,& - LONG_NAME ='crop_specific_sprinkler_irrigation_rate',& + LONG_NAME ='crop_specific_irrigation_flux_sprinkler',& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -335,7 +335,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'DRATE' ,& - LONG_NAME = 'crop_specific_drip_irrigation_rate' ,& + LONG_NAME = 'crop_specific_irrigation_flux_drip' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -347,7 +347,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'FRATE' ,& - LONG_NAME = 'crop_specific_flood_irrigation_rate' ,& + LONG_NAME = 'crop_specific_irrigation_flux_paddy' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -364,8 +364,8 @@ subroutine SetServices ( GC, RC ) ! ----------------------------------------------------------- call MAPL_AddExportSpec(GC ,& - SHORT_NAME = 'SPRINKLERRATE' ,& - LONG_NAME = 'sprinkler_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_SPR' ,& + LONG_NAME = 'irrigation_flux_sprinkler' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -373,8 +373,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - SHORT_NAME = 'DRIPRATE' ,& - LONG_NAME = 'drip_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_DRP' ,& + LONG_NAME = 'irrigation_flux_drip' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -382,8 +382,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - SHORT_NAME = 'FURROWRATE' ,& - LONG_NAME = 'furrow_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_FRW' ,& + LONG_NAME = 'irrigation_flux_furrow' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -391,8 +391,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - SHORT_NAME = 'FLOODRATE' ,& - LONG_NAME = 'flood_irrigation_rate' ,& + SHORT_NAME = 'IRRG_RATE_PDY' ,& + LONG_NAME = 'irrigation_flux_paddy' ,& UNITS = 'kg m-2 s-1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -518,10 +518,10 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! EXPORT ponters - real, dimension(:), pointer :: SPRINKLERRATE - real, dimension(:), pointer :: DRIPRATE - real, dimension(:), pointer :: FURROWRATE - real, dimension(:), pointer :: FLOODRATE + real, dimension(:), pointer :: IRRG_RATE_SPR + real, dimension(:), pointer :: IRRG_RATE_DRP + real, dimension(:), pointer :: IRRG_RATE_FRW + real, dimension(:), pointer :: IRRG_RATE_PDY type(irrigation_model), pointer :: IM type (IRRIG_wrap) :: wrap @@ -566,10 +566,10 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! get pointers to EXPORT variable ! ------------------------------- - call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_SPR, 'IRRG_RATE_SPR',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP, 'IRRG_RATE_DRP',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW, 'IRRG_RATE_FRW',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY, 'IRRG_RATE_PDY',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! Update IRRIGFRAC and PADDYFRAC for applications that are run on regular tiles in ! which IRRIGFRAC and PADDYFRAC in BCs are fractions. @@ -597,7 +597,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! LAI based trigger: scale soil moisture to LAI seasonal cycle ! ============================================================ - call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & + call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) else @@ -605,18 +605,18 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! crop calendar based irrigation ! ============================== - call IM%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & + call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & CROPIRRIGFRAC,SRATE,DRATE,FRATE) endif - ! Scale computed SPRINKLERRATE, DRIPRATE, FURROWRATE, and FLOODRATE to the total + ! Scale computed IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, and IRRG_RATE_PDY to the total ! irrigated tile fraction before exporting to Catchment[CN]. - SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC) - DRIPRATE = DRIPRATE *(IRRIGFRAC) - FURROWRATE = FURROWRATE *(IRRIGFRAC) - FLOODRATE = FLOODRATE *(PADDYFRAC) + IRRG_RATE_SPR = IRRG_RATE_SPR * IRRIGFRAC + IRRG_RATE_DRP = IRRG_RATE_DRP * IRRIGFRAC + IRRG_RATE_FRW = IRRG_RATE_FRW * IRRIGFRAC + IRRG_RATE_PDY = IRRG_RATE_PDY * PADDYFRAC call MAPL_TimerOff(MAPL,"INITIALIZE") RETURN_(ESMF_SUCCESS) @@ -668,10 +668,10 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! EXPORT ponters - real, dimension(:), pointer :: SPRINKLERRATE - real, dimension(:), pointer :: DRIPRATE - real, dimension(:), pointer :: FURROWRATE - real, dimension(:), pointer :: FLOODRATE + real, dimension(:), pointer :: IRRG_RATE_SPR + real, dimension(:), pointer :: IRRG_RATE_DRP + real, dimension(:), pointer :: IRRG_RATE_FRW + real, dimension(:), pointer :: IRRG_RATE_PDY ! IMPORT pointers @@ -743,10 +743,10 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! get pointers to EXPORT variable ! ------------------------------- - call MAPL_GetPointer(EXPORT, SPRINKLERRATE, 'SPRINKLERRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, DRIPRATE, 'DRIPRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FLOODRATE, 'FLOODRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, FURROWRATE, 'FURROWRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_SPR, 'IRRG_RATE_SPR', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP, 'IRRG_RATE_DRP', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY, 'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW, 'IRRG_RATE_FRW', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) @@ -835,7 +835,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) call IM%run_model(IRRIG_METHOD, local_hour, & IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & SMWP,SMSAT,SMREF,SMCNT, LAI, LAIMIN, LAIMAX, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & SRATE, DRATE, FRATE) else @@ -847,18 +847,18 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) SPRINKLERFR, DRIPFR, FLOODFR, & CROPIRRIGFRAC,IRRIGPLANT,IRRIGHARVEST,IRRIGTYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & SRATE, DRATE, FRATE) endif - ! Scale computed SPRINKLERRATE, DRIPRATE, FURROWRATE, and FLOODRATE to the total + ! Scale computed IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, and IRRG_RATE_PDY to the total ! irrigated tile fraction before exporting to Catchment[CN]. - SPRINKLERRATE = SPRINKLERRATE*(IRRIGFRAC) - DRIPRATE = DRIPRATE *(IRRIGFRAC) - FURROWRATE = FURROWRATE *(IRRIGFRAC) - FLOODRATE = FLOODRATE *(PADDYFRAC) + IRRG_RATE_SPR = IRRG_RATE_SPR * IRRIGFRAC + IRRG_RATE_DRP = IRRG_RATE_DRP * IRRIGFRAC + IRRG_RATE_FRW = IRRG_RATE_FRW * IRRIGFRAC + IRRG_RATE_PDY = IRRG_RATE_PDY * PADDYFRAC deallocate (local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF, IM) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 013de351b..da3a4edbf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -29,10 +29,10 @@ MODULE IRRIGATION_MODULE ! method assumes a 10% water loss. (Source FAO) ! ! (1) EXPORTS - MODEL OUTPUTS TO THE LAND MODEL (IRRIGATION RATES): - ! 1) SPRINKLERRATE [kg m-2 s-1] - ! 2) DRIPRATE [kg m-2 s-1] - ! 3) FURROWRATE [kg m-2 s-1] - ! 4) FLOODRATE [kg m-2 s-1] + ! 1) IRRG_RATE_SPR [kg m-2 s-1] + ! 2) IRRG_RATE_DRP [kg m-2 s-1] + ! 3) IRRG_RATE_FRW [kg m-2 s-1] + ! 4) IRRG_RATE_PDY [kg m-2 s-1] ! ! (2) IRRIGATED AND PADDY TILES: ! During land BC's generation, the fraction of irrigated crops and paddy is set to zero @@ -113,7 +113,8 @@ MODULE IRRIGATION_MODULE ! The second dimensions of 2D arrays is for different crop fractions i.e. the second dimension is 2 for above ! IRRIG_TRIGGER: 0 to separately store irrigation rates in irrigated crop and paddy fractions. ! It would be 26 for IRRIG_TRIGGER: 1. - ! The crop calendar implemetation (IRRIG_TRIGGER: 1) computes SPRINKLERRATE, DRIPRATE,FURROWRATE, and FLOODRATE as weighted averages of irrigation rates from + ! The crop calendar implemetation (IRRIG_TRIGGER: 1) computes IRRG_RATE_SPR, IRRG_RATE_DRP, + ! IRRG_RATE_FRW, and IRRG_RATE_PDY as weighted averages of irrigation rates from ! all active crops in SRATE, DRATE and FRATE arrays. PRIVATE @@ -207,7 +208,8 @@ END SUBROUTINE init_model SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN,LAIMAX, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, SRATE, DRATE, FRATE) + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & + SRATE, DRATE, FRATE) implicit none class (irrigation_model), intent(inout) :: this @@ -215,7 +217,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & real, dimension (:), intent (in) :: local_hour real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC, SPRINKLERFR, & DRIPFR, FLOODFR, SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN, LAIMAX, RZDEF - real, dimension (:), intent (inout) :: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE + real, dimension (:), intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE INTEGER :: NTILES, N, crop REAL :: ma, H1, H2, HC, IT, ROOTFRAC, LAITHRES @@ -326,10 +328,11 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & END DO TILE_LOOP - ! Update SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE EXPORTS to be sent to land models. - ! FLOODRATE is weighted averaged over irrigated crops + paddy fractions. + ! Update IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY EXPORTS to be sent to land models. + + ! IRRGRR, this seems outdated: IRRG_RATE_PDY is weighted averaged over irrigated crops + paddy fractions. - call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE, FURROWRATE, & + call this%update_irates (IRRG_RATE_SPR, IRRG_RATE_DRP,IRRG_RATE_PDY, IRRG_RATE_FRW, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) END SUBROUTINE irrigrate_lai_trigger @@ -340,7 +343,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & SPRINKLERFR, DRIPFR, FLOODFR, & CROPIRRIGFRAC,IRRIGPLANT, IRRIGHARVEST, IRRIGTYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - SPRINKLERRATE, DRIPRATE, FLOODRATE, FURROWRATE, SRATE, DRATE, FRATE) + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, SRATE, DRATE, FRATE) implicit none class(irrigation_model),intent(inout):: this @@ -351,7 +354,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & real, dimension(:,:), intent (in) :: IRRIGTYPE ! NUM_CROPS real, dimension(:,:,:),intent (in) :: IRRIGPLANT ! NUM_SEASONS, NUM_CROPS real, dimension(:,:,:),intent (in) :: IRRIGHARVEST ! NUM_SEASONS, NUM_CROPS - real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE + real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE INTEGER :: NTILES, N, crop, sea, ITYPE, I REAL :: ma, H1, H2, HC, IT, ROOTFRAC, void_frac @@ -473,17 +476,17 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & endif IF_IRR END DO TILE_LOOP - ! Update SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE EXPORTS to be sent to land models + ! Update IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY EXPORTS to be sent to land models ! They are weighted averaged over 26 crop fractions. - call this%update_irates (SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & + call this%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & CROPIRRIGFRAC,SRATE,DRATE,FRATE) END SUBROUTINE irrigrate_crop_calendar ! ---------------------------------------------------------------------------- - SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, FURROWRATE, & + SUBROUTINE update_irates_lai (this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) implicit none @@ -491,14 +494,14 @@ SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, FURROWRATE, class(irrigation_model),intent(inout):: this real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE - real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FURROWRATE, FLOODRATE + real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY integer :: N, NT ! INITIALIZE EXPORTS - SPRINKLERRATE = 0. - DRIPRATE = 0. - FLOODRATE = 0. - FURROWRATE = 0. + IRRG_RATE_SPR = 0. + IRRG_RATE_DRP = 0. + IRRG_RATE_PDY = 0. + IRRG_RATE_FRW = 0. NT = size (IRRIGFRAC) @@ -506,10 +509,10 @@ SUBROUTINE update_irates_lai (this,SPRINKLERRATE,DRIPRATE,FLOODRATE, FURROWRATE, DO N = 1, NT IF ((IRRIGFRAC(N) + PADDYFRAC(N)) > 0.) THEN - SPRINKLERRATE (N) = SRATE (N,1) - DRIPRATE (N) = DRATE (N,1) - FURROWRATE (N) = FRATE (N,1) - FLOODRATE (N) = FRATE (N,2) + IRRG_RATE_SPR (N) = SRATE (N,1) + IRRG_RATE_DRP (N) = DRATE (N,1) + IRRG_RATE_FRW (N) = FRATE (N,1) + IRRG_RATE_PDY (N) = FRATE (N,2) ENDIF END DO @@ -517,34 +520,34 @@ END SUBROUTINE update_irates_lai !............................................................................... - SUBROUTINE update_irates_ccalendar(this,SPRINKLERRATE,DRIPRATE,FLOODRATE,FURROWRATE, & + SUBROUTINE update_irates_ccalendar(this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & CROPIRRIGFRAC,SRATE,DRATE,FRATE) implicit none class(irrigation_model),intent(inout):: this real, dimension(:,:), intent (in) :: CROPIRRIGFRAC ! NUM_CROPS real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE - real, dimension (:),intent (inout) :: SPRINKLERRATE, DRIPRATE, FLOODRATE,FURROWRATE + real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW integer :: N, NT, crop ! INITIALIZE EXPORTS - SPRINKLERRATE = 0. - DRIPRATE = 0. - FLOODRATE = 0. - FURROWRATE = 0. + IRRG_RATE_SPR = 0. + IRRG_RATE_DRP = 0. + IRRG_RATE_PDY = 0. + IRRG_RATE_FRW = 0. !_ASSERT(size (SRATE,2)==NUM_CROPS,'Irrigation model crop calandar trigger NUM_CROPS mismatch') - NT = size (SPRINKLERRATE) + NT = size (IRRG_RATE_SPR) DO N = 1, NT if(SUM(CROPIRRIGFRAC(N,:)) > 0.) then DO crop = 1, NUM_CROPS - SPRINKLERRATE(N) = SPRINKLERRATE(N) + SRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) - DRIPRATE(N) = DRIPRATE(N) + DRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + IRRG_RATE_SPR(N) = IRRG_RATE_SPR(N) + SRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + IRRG_RATE_DRP(N) = IRRG_RATE_DRP(N) + DRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) if (crop==3) then ! If crop is rice (crop ==3) then use flood irrigation. Otherwise use furrow irrigation. - FLOODRATE(N) = FLOODRATE(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + IRRG_RATE_PDY(N) = IRRG_RATE_PDY(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) else - FURROWRATE(N) = FURROWRATE(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + IRRG_RATE_FRW(N) = IRRG_RATE_FRW(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) endif END DO endif From d4a20531fa56bd6597c4f029700833f52c34cd1e Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 8 Feb 2025 13:07:08 -0500 Subject: [PATCH 27/55] make "if RUN_IRRIG" statements consistent across GCs (GEOS_LandGridComp.F90) --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 3829a1a5d..8b1ec5192 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -204,7 +204,7 @@ subroutine SetServices ( GC, RC ) END SELECT ! LSM_CHOICE - if(RUN_IRRIG==1) then + if(RUN_IRRIG /= 0) then allocate (IRRIGATION(NUM_CATCH), stat=status) VERIFY_(STATUS) if (NUM_CATCH == 1) then @@ -1383,7 +1383,7 @@ subroutine SetServices ( GC, RC ) END SELECT ! LSM_CHOICE (Catch, CatchCN) - if (RUN_IRRIG == 1) then + if (RUN_IRRIG /= 0) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_SPR', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_PDY', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_FRW', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) @@ -1494,7 +1494,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) end if - if (RUN_IRRIG == 1) then + if (RUN_IRRIG /= 0) then call MAPL_AddConnectivity ( & GC ,& SHORT_NAME = (/'POROS ', 'WPWET ' ,& @@ -1547,7 +1547,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) end if - if (RUN_IRRIG == 1) then + if (RUN_IRRIG /= 0) then call MAPL_AddConnectivity ( & GC ,& SHORT_NAME = (/'POROS ', 'WPWET ' ,& @@ -1579,7 +1579,7 @@ subroutine SetServices ( GC, RC ) ! ENDIF END SELECT - if (RUN_IRRIG == 1) then + if (RUN_IRRIG /= 0) then call MAPL_AddConnectivity ( & GC ,& SHORT_NAME = (/'LAI '/) ,& From d0625a178c67652bb4ccdb5d411a2f9c32528f48 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 8 Feb 2025 13:35:13 -0500 Subject: [PATCH 28/55] make sure soil moisture prognostics (srfexc, rzexc, catdef) remain valid after application of irrigation water (GEOS_CatchGridComp.F90) --- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index d620a05c7..788745c46 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -4221,6 +4221,8 @@ subroutine Driver ( RC ) integer :: NTILES integer :: I, N + real, dimension(:), allocatable :: AR4 ! for catch_calc_soil_moist() after irrigation application + ! dummy variables for call to get snow temp real :: FICE @@ -5264,6 +5266,20 @@ subroutine Driver ( RC ) where (IRRG_RATE_PDY > 0) SRFEXC = SRFEXC + IRRG_RATE_PDY * DT end where + + ! after application of irrigation water, make sure soil moisture prognostics + ! (srfexc, rzexc, catdef) remain valid + ! TO-DO IRRGRR: add optional werror to close water balance + + allocate(ar4(NTILES)) + + call catch_calc_soil_moist( & + NTILES, dzsf_in_mm, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + srfexc, rzexc, catdef, ar1, ar2, ar4 ) + + deallocate(ar4) + endif call MAPL_TimerOn ( MAPL, "-CATCH" ) From 948cf24ac048a300da97cd3674d19045efa7b4d3 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 8 Feb 2025 13:45:37 -0500 Subject: [PATCH 29/55] updated LONG_NAME attributes to match M21C convention (GEOS_IrrigationGridComp.F90) --- .../GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index a8354d6be..9055e8dab 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -414,7 +414,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'WPWET' ,& - LONG_NAME = 'wetness_at_wilting_point' ,& + LONG_NAME = 'soil_wilting_point_in_degree_of_saturation_units' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -432,7 +432,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'WCRZ' ,& - LONG_NAME = 'water_root_zone' ,& + LONG_NAME = 'soil_moisture_rootzone' ,& UNITS = 'm3 m-3' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& From fa23174ccdde51bd303a0caab0314051e333a519 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 8 Feb 2025 13:56:48 -0500 Subject: [PATCH 30/55] added comment about future modifications (GEOS_CatchCNCLM4?GridComp.F90) --- .../GEOS_CatchCNCLM40GridComp.F90 | 8 +++++++- .../GEOS_CatchCNCLM45GridComp.F90 | 3 +++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 19fe328f0..e0f91528e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -6977,7 +6977,13 @@ subroutine Driver ( RC ) where (IRRG_RATE_FRW > 0) RZEXC = RZEXC + IRRG_RATE_FRW * DT end where - ENDIF + + ! IRRGRR: add call to catch_calc_soil_moist() + + ENDIF + + + #ifdef DBG_CNLSM_INPUTS call MAPL_Get(MAPL, LocStream=LOCSTREAM, RC=STATUS) VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 168718e2b..9289b2e09 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -7260,6 +7260,9 @@ subroutine Driver ( RC ) where (IRRG_RATE_FRW > 0) RZEXC = RZEXC + IRRG_RATE_FRW * DT end where + + ! IRRGRR: add call to catch_calc_soil_moist() + ENDIF #ifdef DBG_CNLSM_INPUTS From 6e919a47535e0cf02850f69ac1ebddb30743b9d0 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 8 Feb 2025 17:49:45 -0500 Subject: [PATCH 31/55] first pass renaming irrigation model prognostics and parameters (internal_specs) for clarity and consistency --- .../GEOS_IrrigationGridComp.F90 | 214 +++++++++--------- .../irrigation_model.F90 | 210 ++++++++--------- .../Shared/catch_wrap_state.F90 | 4 +- .../Shared/GEOS_SurfaceGridComp.rc | 40 ++-- .../Utils/Raster/makebcs/clsm_plots.pro | 44 ++-- .../Raster/makebcs/module_irrig_params.F90 | 184 +++++++-------- 6 files changed, 354 insertions(+), 342 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 9055e8dab..b20df2fac 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -31,8 +31,8 @@ module GEOS_IrrigationGridCompMod ! ! EXPORTS: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY\\ ! -! INTERNALS: IRRIGFRAC, PADDYFRAC, CROPIRRIGFRAC, IRRIGPLANT, IRRIGHARVEST, -! IRRIGTYPE, SPRINKLERFR, DRIPFR, FLOODFR, LAIMIN, LAIMAX\\ +! INTERNALS: IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_CROPIRRIGFRAC, IRRG_DOY_PLANT, IRRG_DOY_HARVEST, +! IRRG_TYPE, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, IRRG_LAIMIN, IRRG_LAIMAX\\ ! ! OPTIONAL INTERNALS: SRATE, DRATE, FRATE\\ ! @@ -49,7 +49,7 @@ module GEOS_IrrigationGridCompMod public SetServices - integer :: IRRIG_METHOD, IRRIG_TRIGGER + integer :: IRRG_METHOD, IRRG_TRIGGER integer :: RUN_IRRIG type IRRIG_WRAP @@ -131,9 +131,9 @@ subroutine SetServices ( GC, RC ) call ESMF_ConfigLoadFile( SCF, SURFRC, rc=status) ; VERIFY_(STATUS) - call ESMF_ConfigGetAttribute(SCF, label='RUN_IRRIG:' , value=RUN_IRRIG , DEFAULT=0, __RC__ ) - call ESMF_ConfigGetAttribute(SCF, label='IRRIG_TRIGGER:', value=IRRIG_TRIGGER, DEFAULT=0, __RC__ ) - call ESMF_ConfigGetAttribute(SCF, label='IRRIG_METHOD:' , value=IRRIG_METHOD , DEFAULT=0, __RC__ ) + call ESMF_ConfigGetAttribute(SCF, label='RUN_IRRIG:' , value=RUN_IRRIG , DEFAULT=0, __RC__ ) + call ESMF_ConfigGetAttribute(SCF, label='IRRG_TRIGGER:', value=IRRG_TRIGGER, DEFAULT=0, __RC__ ) + call ESMF_ConfigGetAttribute(SCF, label='IRRG_METHOD:' , value=IRRG_METHOD , DEFAULT=0, __RC__ ) call ESMF_ConfigDestroy (SCF, __RC__) @@ -158,7 +158,7 @@ subroutine SetServices ( GC, RC ) ! ----------------------------------------------------------- call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'IRRIGFRAC' ,& + SHORT_NAME = 'IRRG_IRRIGFRAC' ,& LONG_NAME = 'fraction_of_irrigated_cropland' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -169,7 +169,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'PADDYFRAC' ,& + SHORT_NAME = 'IRRG_PADDYFRAC' ,& LONG_NAME = 'fraction_of_paddy_cropland' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -180,55 +180,55 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'CROPIRRIGFRAC' ,& + SHORT_NAME = 'IRRG_CROPIRRIGFRAC' ,& LONG_NAME = 'Crop_irrigated_fraction' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& - UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + UNGRIDDED_DIMS = (/IRRG_NCROPS/) ,& RESTART = MAPL_RestartRequired ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'IRRIGPLANT' ,& + SHORT_NAME = 'IRRG_DOY_PLANT' ,& LONG_NAME = 'DOY_start_planting' ,& UNITS = 'day' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& - UNGRIDDED_DIMS = (/NUM_SEASONS, NUM_CROPS/) ,& + UNGRIDDED_DIMS = (/IRRG_NSEASONS, IRRG_NCROPS/) ,& RESTART = MAPL_RestartRequired ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'IRRIGHARVEST' ,& + SHORT_NAME = 'IRRG_DOY_HARVEST' ,& LONG_NAME = 'DOY_end_harvesting' ,& UNITS = 'day' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& - UNGRIDDED_DIMS = (/NUM_SEASONS, NUM_CROPS/) ,& + UNGRIDDED_DIMS = (/IRRG_NSEASONS, IRRG_NCROPS/) ,& RESTART = MAPL_RestartRequired ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'IRRIGTYPE' ,& + SHORT_NAME = 'IRRG_TYPE' ,& LONG_NAME = 'Preferred_Irrig_method=(0)CONCURRENT_(1)SPRINKLER_(2)DRIP_(3)FLOOD_(negative)AVOID',& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& - UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + UNGRIDDED_DIMS = (/IRRG_NCROPS/) ,& RESTART = MAPL_RestartRequired ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'SPRINKLERFR' ,& + SHORT_NAME = 'IRRG_IRRIGFRAC_SPR' ,& LONG_NAME = 'fraction_of_sprinkler_irrigation' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -238,7 +238,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'DRIPFR' ,& + SHORT_NAME = 'IRRG_IRRIGFRAC_DRP' ,& LONG_NAME = 'fraction_of_drip_irrigation' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -249,7 +249,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'FLOODFR' ,& + SHORT_NAME = 'IRRG_IRRIGFRAC_FRW' ,& LONG_NAME = 'fraction_of_flood_irrigation' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -260,7 +260,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'LAIMIN' ,& + SHORT_NAME = 'IRRG_LAIMIN' ,& LONG_NAME = 'Minimum_LAI_irrigated_crops' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -271,7 +271,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - SHORT_NAME = 'LAIMAX' ,& + SHORT_NAME = 'IRRG_LAIMAX' ,& LONG_NAME = 'Maximum_LAI_irrigated_crops' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -281,7 +281,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - if (IRRIG_TRIGGER == 0) then + if (IRRG_TRIGGER == 0) then ! only two crop types: irrigated crops and paddy in that order. call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'SRATE' ,& @@ -319,7 +319,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - elseif (IRRIG_TRIGGER == 1) then + elseif (IRRG_TRIGGER == 1) then call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'SRATE' ,& @@ -329,7 +329,7 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& RESTART = MAPL_RestartOptional ,& - UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + UNGRIDDED_DIMS = (/IRRG_NCROPS/) ,& RC=STATUS ) VERIFY_(STATUS) @@ -341,7 +341,7 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& RESTART = MAPL_RestartOptional ,& - UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + UNGRIDDED_DIMS = (/IRRG_NCROPS/) ,& RC=STATUS ) VERIFY_(STATUS) @@ -353,7 +353,7 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& RESTART = MAPL_RestartOptional ,& - UNGRIDDED_DIMS = (/NUM_CROPS/) ,& + UNGRIDDED_DIMS = (/IRRG_NCROPS/) ,& RC=STATUS ) VERIFY_(STATUS) @@ -508,10 +508,10 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! INTERNAL pointers - real, dimension(:), pointer :: IRRIGFRAC - real, dimension(:), pointer :: PADDYFRAC - real, dimension(:,:), pointer :: CROPIRRIGFRAC - real, dimension(:,:), pointer :: IRRIGTYPE + real, dimension(:), pointer :: IRRG_IRRIGFRAC + real, dimension(:), pointer :: IRRG_PADDYFRAC + real, dimension(:,:), pointer :: IRRG_CROPIRRIGFRAC + real, dimension(:,:), pointer :: IRRG_TYPE real, dimension(:,:), pointer :: SRATE real, dimension(:,:), pointer :: DRATE real, dimension(:,:), pointer :: FRATE @@ -556,49 +556,49 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! get pointers to internal variables ! ---------------------------------- - call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_IRRIGFRAC ,'IRRG_IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_PADDYFRAC ,'IRRG_PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_CROPIRRIGFRAC ,'IRRG_CROPIRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_TYPE ,'IRRG_TYPE', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! get pointers to EXPORT variable ! ------------------------------- - call MAPL_GetPointer(EXPORT, IRRG_RATE_SPR, 'IRRG_RATE_SPR',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP, 'IRRG_RATE_DRP',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW, 'IRRG_RATE_FRW',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY, 'IRRG_RATE_PDY',ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_SPR, 'IRRG_RATE_SPR', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP, 'IRRG_RATE_DRP', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW, 'IRRG_RATE_FRW', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY, 'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - ! Update IRRIGFRAC and PADDYFRAC for applications that are run on regular tiles in - ! which IRRIGFRAC and PADDYFRAC in BCs are fractions. - ! The irrigation model would run on tiles with IRRIGFRAC + PADDYFRAC > IRRIG_THRES (default is 0.01). + ! Update IRRG_IRRIGFRAC and IRRG_PADDYFRAC for applications that are run on regular tiles in + ! which IRRG_IRRIGFRAC and IRRG_PADDYFRAC in BCs are fractions. + ! The irrigation model would run on tiles with IRRG_IRRIGFRAC + IRRG_PADDYFRAC > IRRG_FRAC_THRES (default is 0.01). - where (IRRIGFRAC + PADDYFRAC > IM%IRRIG_THRES) + where (IRRG_IRRIGFRAC + IRRG_PADDYFRAC > IM%IRRG_FRAC_THRES) ! uncomment the following block to assign the entire cell to the largest fraction: - ! where (PADDYFRAC >= IRRIGFRAC) - ! PADDYFRAC = 1. - ! IRRIGFRAC = 0. + ! where (IRRG_PADDYFRAC >= IRRG_IRRIGFRAC) + ! IRRG_PADDYFRAC = 1. + ! IRRG_IRRIGFRAC = 0. ! elsewhere - ! PADDYFRAC = 0. - ! IRRIGFRAC = 1. + ! IRRG_PADDYFRAC = 0. + ! IRRG_IRRIGFRAC = 1. ! endwhere elsewhere - PADDYFRAC = 0. - IRRIGFRAC = 0. + IRRG_PADDYFRAC = 0. + IRRG_IRRIGFRAC = 0. endwhere - if (IRRIG_TRIGGER == 0) then + if (IRRG_TRIGGER == 0) then ! LAI based trigger: scale soil moisture to LAI seasonal cycle ! ============================================================ call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & - IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) + IRRG_IRRIGFRAC,IRRG_PADDYFRAC,SRATE,DRATE,FRATE) else @@ -606,17 +606,17 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! ============================== call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & - CROPIRRIGFRAC,SRATE,DRATE,FRATE) + IRRG_CROPIRRIGFRAC,SRATE,DRATE,FRATE) endif ! Scale computed IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, and IRRG_RATE_PDY to the total ! irrigated tile fraction before exporting to Catchment[CN]. - IRRG_RATE_SPR = IRRG_RATE_SPR * IRRIGFRAC - IRRG_RATE_DRP = IRRG_RATE_DRP * IRRIGFRAC - IRRG_RATE_FRW = IRRG_RATE_FRW * IRRIGFRAC - IRRG_RATE_PDY = IRRG_RATE_PDY * PADDYFRAC + IRRG_RATE_SPR = IRRG_RATE_SPR * IRRG_IRRIGFRAC + IRRG_RATE_DRP = IRRG_RATE_DRP * IRRG_IRRIGFRAC + IRRG_RATE_FRW = IRRG_RATE_FRW * IRRG_IRRIGFRAC + IRRG_RATE_PDY = IRRG_RATE_PDY * IRRG_PADDYFRAC call MAPL_TimerOff(MAPL,"INITIALIZE") RETURN_(ESMF_SUCCESS) @@ -651,17 +651,17 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! INTERNAL pointers - real, dimension(:), pointer :: IRRIGFRAC - real, dimension(:), pointer :: PADDYFRAC - real, dimension(:), pointer :: SPRINKLERFR - real, dimension(:), pointer :: DRIPFR - real, dimension(:), pointer :: FLOODFR - real, dimension(:), pointer :: LAIMIN - real, dimension(:), pointer :: LAIMAX - real, dimension(:,:), pointer :: CROPIRRIGFRAC - real, dimension(:,:), pointer :: IRRIGTYPE - real, dimension(:,:,:), pointer :: IRRIGPLANT - real, dimension(:,:,:), pointer :: IRRIGHARVEST + real, dimension(:), pointer :: IRRG_IRRIGFRAC + real, dimension(:), pointer :: IRRG_PADDYFRAC + real, dimension(:), pointer :: IRRG_IRRIGFRAC_SPR + real, dimension(:), pointer :: IRRG_IRRIGFRAC_DRP + real, dimension(:), pointer :: IRRG_IRRIGFRAC_FRW + real, dimension(:), pointer :: IRRG_LAIMIN + real, dimension(:), pointer :: IRRG_LAIMAX + real, dimension(:,:), pointer :: IRRG_CROPIRRIGFRAC + real, dimension(:,:), pointer :: IRRG_TYPE + real, dimension(:,:,:), pointer :: IRRG_DOY_PLANT + real, dimension(:,:,:), pointer :: IRRG_DOY_HARVEST real, dimension(:,:), pointer :: SRATE real, dimension(:,:), pointer :: DRATE real, dimension(:,:), pointer :: FRATE @@ -726,38 +726,38 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! get pointers to internal variables ! ---------------------------------- - call MAPL_GetPointer(INTERNAL, IRRIGFRAC ,'IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, PADDYFRAC ,'PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, CROPIRRIGFRAC ,'CROPIRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGPLANT ,'IRRIGPLANT', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGHARVEST ,'IRRIGHARVEST', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, IRRIGTYPE ,'IRRIGTYPE', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, SPRINKLERFR ,'SPRINKLERFR', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, DRIPFR ,'DRIPFR', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, FLOODFR ,'FLOODFR', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LAIMIN ,'LAIMIN', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LAIMAX ,'LAIMAX', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_IRRIGFRAC ,'IRRG_IRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_PADDYFRAC ,'IRRG_PADDYFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_CROPIRRIGFRAC ,'IRRG_CROPIRRIGFRAC', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_DOY_PLANT ,'IRRG_DOY_PLANT', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_DOY_HARVEST ,'IRRG_DOY_HARVEST', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_TYPE ,'IRRG_TYPE', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_IRRIGFRAC_SPR ,'IRRG_IRRIGFRAC_SPR', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_IRRIGFRAC_DRP ,'IRRG_IRRIGFRAC_DRP', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_IRRIGFRAC_FRW ,'IRRG_IRRIGFRAC_FRW', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_LAIMIN ,'IRRG_LAIMIN', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, IRRG_LAIMAX ,'IRRG_LAIMAX', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, SRATE ,'SRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, DRATE ,'DRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, FRATE ,'FRATE', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! get pointers to EXPORT variable ! ------------------------------- - call MAPL_GetPointer(EXPORT, IRRG_RATE_SPR, 'IRRG_RATE_SPR', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP, 'IRRG_RATE_DRP', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY, 'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW, 'IRRG_RATE_FRW', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_SPR ,'IRRG_RATE_SPR', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP ,'IRRG_RATE_DRP', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY ,'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW ,'IRRG_RATE_FRW', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) ! get pointers to IMPORT variables ! -------------------------------- - call MAPL_GetPointer(IMPORT, POROS , 'POROS', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, WPWET , 'WPWET', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, VGWMAX , 'VGWMAX', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, WCRZ , 'WCRZ', RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT, LAI , 'LAI', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, POROS ,'POROS', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, WPWET ,'WPWET', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, VGWMAX ,'VGWMAX', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, WCRZ ,'WCRZ', RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, LAI ,'LAI', RC=STATUS) ; VERIFY_(STATUS) ! Get time and parameters from local state ! ---------------------------------------- @@ -827,15 +827,15 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) END DO - if (IRRIG_TRIGGER == 0) then + if (IRRG_TRIGGER == 0) then ! LAI based trigger: scale soil moisture to LAI seasonal cycle ! ============================================================ - call IM%run_model(IRRIG_METHOD, local_hour, & - IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & - SMWP,SMSAT,SMREF,SMCNT, LAI, LAIMIN, LAIMAX, RZDEF, & - IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & + call IM%run_model(IRRG_METHOD, local_hour, & + IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & + SMWP,SMSAT,SMREF,SMCNT, LAI, IRRG_LAIMIN, IRRG_LAIMAX, RZDEF, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & SRATE, DRATE, FRATE) else @@ -843,11 +843,11 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! crop calendar based irrigation ! ============================== - call IM%run_model (dofyr,local_hour, & - SPRINKLERFR, DRIPFR, FLOODFR, & - CROPIRRIGFRAC,IRRIGPLANT,IRRIGHARVEST,IRRIGTYPE , & - SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & + call IM%run_model (dofyr,local_hour, & + IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & + IRRG_CROPIRRIGFRAC,IRRG_DOY_PLANT,IRRG_DOY_HARVEST,IRRG_TYPE , & + SMWP,SMSAT,SMREF,SMCNT, RZDEF, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & SRATE, DRATE, FRATE) endif @@ -855,10 +855,10 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! Scale computed IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, and IRRG_RATE_PDY to the total ! irrigated tile fraction before exporting to Catchment[CN]. - IRRG_RATE_SPR = IRRG_RATE_SPR * IRRIGFRAC - IRRG_RATE_DRP = IRRG_RATE_DRP * IRRIGFRAC - IRRG_RATE_FRW = IRRG_RATE_FRW * IRRIGFRAC - IRRG_RATE_PDY = IRRG_RATE_PDY * PADDYFRAC + IRRG_RATE_SPR = IRRG_RATE_SPR * IRRG_IRRIGFRAC + IRRG_RATE_DRP = IRRG_RATE_DRP * IRRG_IRRIGFRAC + IRRG_RATE_FRW = IRRG_RATE_FRW * IRRG_IRRIGFRAC + IRRG_RATE_PDY = IRRG_RATE_PDY * IRRG_PADDYFRAC deallocate (local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF, IM) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index da3a4edbf..a8f23d7a0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -52,31 +52,37 @@ MODULE IRRIGATION_MODULE ! ! (4) SEASONAL CYLCE OF CROP WATER DEMAND: ! The module provides 2 options to determine the seasonal cycle of crop water demand: - ! 4.1) IRRIG_TRIGGER: 0 - SUBROUTINE irrigrate_lai_trigger + ! 4.1) IRRG_TRIGGER: 0 - SUBROUTINE irrigrate_lai_trigger ! The LAI-based trigger (Default and the current LIS implementation) ! uses precomputed minimum and maximum LAI on irrigateed pixels to determine ! beginning and end of crop growing seasons. ! - ! This LAI-based trigger is also equipped with an additional control parameter, IRRIG_METHOD, + ! This LAI-based trigger is also equipped with an additional control parameter, IRRG_METHOD, ! which is good to choose the method of irrigation that would run on corresponding fraction: - ! i) 0: (Default) All 4 methods (sprinkler/furrow/flood/drip) concurrently. - ! ii) 1: Sprinkler irrigation on entire tile. - ! iv) 2: Drip irrigation on entire tile. - ! iii) 3: Furrow/Flood irrigation on entire tile. + ! 0: (Default) All 4 methods (sprinkler/drip/furrow/paddy) concurrently, according to specified area fracs + ! 1: Only sprinkler irrigation on *entire* tile (regardless of IRRIGFRAC or PADDYFRAC) + ! 2: Only drip irrigation on *entire* tile (regardless of IRRIGFRAC or PADDYFRAC) + ! 3: Only furrow/flood irrigation on *entire* tile (regardless of IRRIGFRAC or PADDYFRAC) + ! + ! IRRG_TRIGGER: 0 SPECIFIC INPUTS: + ! IRRG_IRRIGFRAC : fraction of tile covered by sprinkler/drip/furrow-irrigated crops; + ! ranges between 0 and 1 (if IRRG_IRRIGFRAC + IRRG_PADDYFRAC > Irrigation Threshold) + ! IRRG_PADDYFRAC : fraction of tile covered by paddy; + ! ranges between 0 and 1 (if IRRG_IRRIGFRAC + IRRG_PADDYFRAC > Irrigation Threshold) + ! + ! Within IRRIGFRAC, allocation by irrigation method: + ! + ! Note: IRRG_IRRIGFRAC_SPR + IRRG_IRRIGFRAC_DRP + IRRG_IRRIGFRAC_FRW = 1. + ! + ! IRRG_IRRIGFRAC_SPR : fraction of IRRG_IRRIGFRAC equipped for sprinkler irrigation + ! IRRG_IRRIGFRAC_DRP : fraction of IRRG_IRRIGFRAC equipped for drip irrigation + ! IRRG_IRRIGFRAC_FRW : fraction of IRRG_IRRIGFRAC equipped for flood/furrow irrigation ! - ! IRRIG_TRIGGER: 0 SPECIFIC INPUTS: - ! IRRIGFRAC : fraction of tile covered by irrigated crops; - ! ranges between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation Threshold) - ! PADDYFRAC : fraction of tile covered by paddy; - ! ranges between 0 and 1 (if IRRIGFRAC + PADDYFRAC > Irrigation Threshold) - ! SPRINKLERFR : fraction of tile equipped for sprinkler irrigation - ! DRIPFR : fraction of tile equipped for drip irrigation - ! FLOODFR : fraction of tile equipped for flood/furrow irrigation ! LAI : time varying Leaf Area Index from the model - ! LAIMIN : Minimum LAI spatially averaged over the irrigated tile fraction - ! LAIMAX : Maximum LAI spatially averaged over the irrigated tile fraction + ! IRRG_LAIMIN : Minimum LAI spatially averaged over the irrigated tile fraction + ! IRRG_LAIMAX : Maximum LAI spatially averaged over the irrigated tile fraction ! - ! 4.2) IRRIG_TRIGGER: 1 - SUBROUTINE irrigrate_crop_calendar + ! 4.2) IRRG_TRIGGER: 1 - SUBROUTINE irrigrate_crop_calendar ! Uses 26 crop calendars based on monthly crop growing areas of below crops. ! 1 Wheat 14 Oil palm ! 2 Maize 15 Rape seed / Canola @@ -92,43 +98,45 @@ MODULE IRRIGATION_MODULE ! 12 Sugar cane 25 Fodder grasses ! 13 Sugar beet 26 Others annual ! - ! IRRIG_TRIGGER: 1 SPECIFIC INPUTS: + ! IRRG_TRIGGER: 1 SPECIFIC INPUTS: ! DOFYR : day of year - ! IRRIGTYPE : Preferred Irrig method (NTILES, 26) - + ! IRRG_TYPE : Preferred Irrig method (NTILES, 26) - ! 0 CONCURRENT (default), ! 1 SPRINKLER ONLY ! 2 DRIP ONLY ! 3 FLOOD/FURROW ONLY, and ! <0 AVOID this method - ! CROPIRRIGFRAC: Crop irrigated fraction (NTILES, 26) (per Section 2, fractions have been - ! adjusted such that CROPIRRIGFRAC=1. on paddy tiles; the sum of available + ! IRRG_CROPIRRIGFRAC: Crop irrigated fraction (NTILES, 26) (per Section 2, fractions have been + ! adjusted such that IRRG_CROPIRRIGFRAC=1. on paddy tiles; the sum of available ! crop fractions equals 1. on irrigated crop tiles; ! and is zero on non-irrigated tiles. - ! IRRIGPLANT : DOY start planting (NTILES, 2, 26) - up to two seasons - ! IRRIGHARVEST : DOY end harvesting (NTILES, 2, 26) - up to two seasons - ! If IRRIGPLANT/IRRIGHARVEST = 998, the crop is not grown on that tile + ! IRRG_DOY_PLANT : DOY start planting (NTILES, 2, 26) - up to two seasons + ! IRRG_DOY_HARVEST : DOY end harvesting (NTILES, 2, 26) - up to two seasons + ! If IRRG_DOY_PLANT = IRRG_DOY_HARVEST = 998, the crop is not grown on that tile ! ! (5) MODEL UPDATES (OPTIONAL INTERNALS): ! SRATE, DRATE, and FRATE contain irrigation rates applied on individual fractions at any given time. ! The second dimensions of 2D arrays is for different crop fractions i.e. the second dimension is 2 for above - ! IRRIG_TRIGGER: 0 to separately store irrigation rates in irrigated crop and paddy fractions. - ! It would be 26 for IRRIG_TRIGGER: 1. - ! The crop calendar implemetation (IRRIG_TRIGGER: 1) computes IRRG_RATE_SPR, IRRG_RATE_DRP, + ! IRRG_TRIGGER: 0 to separately store irrigation rates in irrigated crop and paddy fractions. + ! It would be 26 for IRRG_TRIGGER: 1. + ! The crop calendar implemetation (IRRG_TRIGGER: 1) computes IRRG_RATE_SPR, IRRG_RATE_DRP, ! IRRG_RATE_FRW, and IRRG_RATE_PDY as weighted averages of irrigation rates from ! all active crops in SRATE, DRATE and FRATE arrays. PRIVATE - INTEGER, PARAMETER, PUBLIC :: NUM_CROPS = 26, NUM_SEASONS = 2 + INTEGER, PARAMETER, PUBLIC :: IRRG_NCROPS = 26, IRRG_NSEASONS = 2 type, public :: irrig_params ! Below parameters can be set via RC file. + ! IRRGRR: Do we really want to hardwire defaults here *and* in GEOS_SurfaceGridComp.rc ??? + REAL :: irrig_thres = 0.01 ! threshold of tile fraction to turn the irrigation model on. REAL :: lai_thres = 0.6 ! threshold of LAI range to turn irrigation on REAL :: efcor = 25.0 ! Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use) - REAL :: MIDS_LENGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER: 1) + REAL :: MIDS_LENGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER: 1) ! Sprinkler parameters ! -------------------- @@ -187,47 +195,47 @@ SUBROUTINE init_model (IP, SURFRC) SCF = ESMF_ConfigCreate(__RC__) CALL ESMF_ConfigLoadFile (SCF,SURFRC,rc=status) ; VERIFY_(STATUS) - CALL ESMF_ConfigGetAttribute (SCF, label='SPRINKLER_STIME:', VALUE=IP%sprinkler_stime, DEFAULT=DP%sprinkler_stime, __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='SPRINKLER_DUR:' , VALUE=IP%sprinkler_dur, DEFAULT=DP%sprinkler_dur , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='SPRINKLER_THRES:', VALUE=IP%sprinkler_thres, DEFAULT=DP%sprinkler_thres, __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='DRIP_STIME:' , VALUE=IP%drip_stime, DEFAULT=DP%drip_stime , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='DRIP_DUR:' , VALUE=IP%drip_dur, DEFAULT=DP%drip_dur , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='FLOOD_STIME:' , VALUE=IP%flood_stime, DEFAULT=DP%flood_stime , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='FLOOD_DUR:' , VALUE=IP%flood_dur, DEFAULT=DP%flood_dur , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='FLOOD_THRES:' , VALUE=IP%flood_thres, DEFAULT=DP%flood_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_SPR_STIME:' , VALUE=IP%sprinkler_stime, DEFAULT=DP%sprinkler_stime, __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_SPR_DUR:' , VALUE=IP%sprinkler_dur, DEFAULT=DP%sprinkler_dur , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_SPR_THRES:' , VALUE=IP%sprinkler_thres, DEFAULT=DP%sprinkler_thres, __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_DRP_STIME:' , VALUE=IP%drip_stime, DEFAULT=DP%drip_stime , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_DRP_DUR:' , VALUE=IP%drip_dur, DEFAULT=DP%drip_dur , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_STIME:' , VALUE=IP%flood_stime, DEFAULT=DP%flood_stime , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_DUR:' , VALUE=IP%flood_dur, DEFAULT=DP%flood_dur , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_THRES:' , VALUE=IP%flood_thres, DEFAULT=DP%flood_thres , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRR_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='LAI_THRES:' , VALUE=IP%lai_thres, DEFAULT=DP%lai_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_LAI_THRES:' , VALUE=IP%lai_thres, DEFAULT=DP%lai_thres , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='MIDS_LENGTH:' , VALUE=IP%MIDS_LENGTH, DEFAULT=DP%lai_thres , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='IRRIG_THRES:' , VALUE=IP%irrig_thres, DEFAULT=DP%irrig_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FRAC_THRES:', VALUE=IP%irrig_thres, DEFAULT=DP%irrig_thres , __RC__ ) CALL ESMF_ConfigDestroy (SCF, __RC__) END SUBROUTINE init_model ! ---------------------------------------------------------------------------- - SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & - IRRIGFRAC, PADDYFRAC, SPRINKLERFR, DRIPFR, FLOODFR, & - SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN,LAIMAX, RZDEF, & - IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & + SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, & + IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & + SMWP, SMSAT, SMREF, SMCNT, LAI, IRRG_LAIMIN,IRRG_LAIMAX, RZDEF, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & SRATE, DRATE, FRATE) implicit none class (irrigation_model), intent(inout) :: this - integer, intent (in) :: IRRIG_METHOD + integer, intent (in) :: IRRG_METHOD real, dimension (:), intent (in) :: local_hour - real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC, SPRINKLERFR, & - DRIPFR, FLOODFR, SMWP, SMSAT, SMREF, SMCNT, LAI, LAIMIN, LAIMAX, RZDEF + real, dimension (:), intent (in) :: IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_IRRIGFRAC_SPR, & + IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, SMWP, SMSAT, SMREF, SMCNT, LAI, IRRG_LAIMIN, IRRG_LAIMAX, RZDEF real, dimension (:), intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE INTEGER :: NTILES, N, crop REAL :: ma, H1, H2, HC, IT, ROOTFRAC, LAITHRES logical :: season_end - NTILES = SIZE (IRRIGFRAC) + NTILES = SIZE (IRRG_IRRIGFRAC) TILE_LOOP : DO N = 1, NTILES - IF(LAIMAX (N) > LAIMIN (N)) THEN - LAITHRES = LAIMIN (N) + this%lai_thres * (LAIMAX (N) - LAIMIN (N)) - ROOTFRAC = MIN((LAI(N) - LAIMIN (N)) / (LAIMAX(N) - LAIMIN(N)) ,1.0) + IF(IRRG_LAIMAX (N) > IRRG_LAIMIN (N)) THEN + LAITHRES = IRRG_LAIMIN (N) + this%lai_thres * (IRRG_LAIMAX (N) - IRRG_LAIMIN (N)) + ROOTFRAC = MIN((LAI(N) - IRRG_LAIMIN (N)) / (IRRG_LAIMAX(N) - IRRG_LAIMIN(N)) ,1.0) ELSE ROOTFRAC = 0. ENDIF @@ -237,12 +245,12 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & CHECK_LAITHRES : IF (LAI(N) >= LAITHRES) THEN season_end = .false. - CHECK_IRRIGFRACS: IF ((IRRIGFRAC(N) > 0.).OR.(PADDYFRAC(N)>0.)) THEN + CHECK_IRRIGFRACS: IF ((IRRG_IRRIGFRAC(N) > 0.).OR.(IRRG_PADDYFRAC(N)>0.)) THEN !----------------------------------------------------------------------------- ! Get the rootzone moisture availability to the plant !----------------------------------------------------------------------------- - if (IRRIGFRAC(N) > 0.) then + if (IRRG_IRRIGFRAC(N) > 0.) then if(SMREF(N) > SMWP(N))then ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) else @@ -251,7 +259,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & if(ma >= 0) then - SELECT CASE (IRRIG_METHOD) + SELECT CASE (IRRG_METHOD) CASE (0) ! CONCURRENTLY SPRINKER + FLOOD + FURROW + DRIP on corresponding fractions call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & @@ -259,9 +267,9 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & DRATE = DRATE (N,1), & FRATE = FRATE (N,1)) - SRATE (N,1) = SRATE (N,1)*SPRINKLERFR(N) - DRATE (N,1) = DRATE (N,1)*DRIPFR (N) - FRATE (N,1) = FRATE (N,1)*FLOODFR (N) + SRATE (N,1) = SRATE (N,1)*IRRG_IRRIGFRAC_SPR(N) + DRATE (N,1) = DRATE (N,1)*IRRG_IRRIGFRAC_DRP (N) + FRATE (N,1) = FRATE (N,1)*IRRG_IRRIGFRAC_FRW (N) CASE (1) ! SPRINKLER only @@ -288,13 +296,13 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & DRATE (N,1) = 0. CASE DEFAULT - PRINT *, 'irrigrate_lai_trigger: IRRIG_METHOD can be 0,1,2, or3' + PRINT *, 'irrigrate_lai_trigger: IRRG_METHOD can be 0,1,2, or3' CALL EXIT(1) END SELECT endif endif - if (PADDYFRAC (N) > 0.) then + if (IRRG_PADDYFRAC (N) > 0.) then H1 = this%flood_stime H2 = this%flood_stime + this%flood_dur @@ -333,46 +341,46 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRIG_METHOD, local_hour, & ! IRRGRR, this seems outdated: IRRG_RATE_PDY is weighted averaged over irrigated crops + paddy fractions. call this%update_irates (IRRG_RATE_SPR, IRRG_RATE_DRP,IRRG_RATE_PDY, IRRG_RATE_FRW, & - IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) + IRRG_IRRIGFRAC,IRRG_PADDYFRAC,SRATE,DRATE,FRATE) END SUBROUTINE irrigrate_lai_trigger ! ---------------------------------------------------------------------------- SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & - SPRINKLERFR, DRIPFR, FLOODFR, & - CROPIRRIGFRAC,IRRIGPLANT, IRRIGHARVEST, IRRIGTYPE , & + IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & + IRRG_CROPIRRIGFRAC,IRRG_DOY_PLANT, IRRG_DOY_HARVEST, IRRG_TYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, SRATE, DRATE, FRATE) implicit none class(irrigation_model),intent(inout):: this integer, intent (in) :: dofyr - real, dimension (:), intent (in) :: local_hour, SPRINKLERFR, DRIPFR, FLOODFR + real, dimension (:), intent (in) :: local_hour, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW real, dimension (:), intent (in) :: SMWP, SMSAT, SMREF, SMCNT, RZDEF - real, dimension(:,:), intent (in) :: CROPIRRIGFRAC ! NUM_CROPS - real, dimension(:,:), intent (in) :: IRRIGTYPE ! NUM_CROPS - real, dimension(:,:,:),intent (in) :: IRRIGPLANT ! NUM_SEASONS, NUM_CROPS - real, dimension(:,:,:),intent (in) :: IRRIGHARVEST ! NUM_SEASONS, NUM_CROPS + real, dimension(:,:), intent (in) :: IRRG_CROPIRRIGFRAC ! IRRG_NCROPS + real, dimension(:,:), intent (in) :: IRRG_TYPE ! IRRG_NCROPS + real, dimension(:,:,:),intent (in) :: IRRG_DOY_PLANT ! IRRG_NSEASONS, IRRG_NCROPS + real, dimension(:,:,:),intent (in) :: IRRG_DOY_HARVEST ! IRRG_NSEASONS, IRRG_NCROPS real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE INTEGER :: NTILES, N, crop, sea, ITYPE, I REAL :: ma, H1, H2, HC, IT, ROOTFRAC, void_frac - logical :: season_end (NUM_CROPS) + logical :: season_end (IRRG_NCROPS) NTILES = SIZE (local_hour) TILE_LOOP : DO N = 1, NTILES HC = local_hour(n) - IF_IRR: if(SUM(CROPIRRIGFRAC(N,:)) > 0.) then + IF_IRR: if(SUM(IRRG_CROPIRRIGFRAC(N,:)) > 0.) then ! the tile is irrigated crop or paddy season_end = .true. - CROP_LOOP: DO crop = 1, NUM_CROPS - CROP_IN_TILE: if(CROPIRRIGFRAC(N,crop) > 0.) then + CROP_LOOP: DO crop = 1, IRRG_NCROPS + CROP_IN_TILE: if(IRRG_CROPIRRIGFRAC(N,crop) > 0.) then ! crop is grown in this tile - TWO_SEASONS: do sea = 1, NUM_SEASONS - IS_CROP: IF(IRRIGPLANT(N, sea, crop) /= 998) THEN + TWO_SEASONS: do sea = 1, IRRG_NSEASONS + IS_CROP: IF(IRRG_DOY_PLANT(N, sea, crop) /= 998) THEN ! crop is grown in sea - IS_SEASON: IF(IS_WITHIN_SEASON(dofyr,NINT(IRRIGPLANT(N, sea, crop)),NINT(IRRIGHARVEST(N, sea, crop)))) THEN + IS_SEASON: IF(IS_WITHIN_SEASON(dofyr,NINT(IRRG_DOY_PLANT(N, sea, crop)),NINT(IRRG_DOY_HARVEST(N, sea, crop)))) THEN ! dofyr falls within the crop season season_end(crop) = .false. PADDY_OR_CROP: if (crop == 3) then @@ -392,7 +400,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & ! IRRIGATED CROP: compute sum of irrigrates from 25 crops. - ROOTFRAC = CROP_SEASON_STAGE (this%MIDS_LENGTH, dofyr,NINT(IRRIGPLANT(N, sea, crop)),NINT(IRRIGHARVEST(N, sea, crop))) + ROOTFRAC = CROP_SEASON_STAGE (this%MIDS_LENGTH, dofyr,NINT(IRRG_DOY_PLANT(N, sea, crop)),NINT(IRRG_DOY_HARVEST(N, sea, crop))) if(SMREF(N) > SMWP(N))then ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) else @@ -401,7 +409,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & SOILM: if(ma >= 0) then - ITYPE = NINT(IRRIGTYPE(N,crop)) + ITYPE = NINT(IRRG_TYPE(N,crop)) CROP_IMETHOD: if (ITYPE == 0) then @@ -411,9 +419,9 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & DRATE = DRATE (N,crop), & FRATE = FRATE (N,crop)) - SRATE (N,crop) = SRATE (N,crop)*SPRINKLERFR(N) - DRATE (N,crop) = DRATE (N,crop)*DRIPFR (N) - FRATE (N,crop) = FRATE (N,crop)*FLOODFR (N) + SRATE (N,crop) = SRATE (N,crop)*IRRG_IRRIGFRAC_SPR(N) + DRATE (N,crop) = DRATE (N,crop)*IRRG_IRRIGFRAC_DRP (N) + FRATE (N,crop) = FRATE (N,crop)*IRRG_IRRIGFRAC_FRW (N) elseif (ITYPE > 0) then @@ -424,21 +432,21 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & elseif (ITYPE < 0) then - ! crop does not use IRRIG_METHOD -(ITYPE) + ! crop does not use IRRG_METHOD -(ITYPE) void_frac = 0. DO I = 1,3 if(I == ABS(ITYPE))then ! this itype isn't used by this crop other 2 fractions equally share this fraction if (I == 1) then - void_frac = SPRINKLERFR(N)/2. + void_frac = IRRG_IRRIGFRAC_SPR(N)/2. SRATE(N,crop) = 0. endif if (I == 2) then - void_frac = DRIPFR (N)/2. + void_frac = IRRG_IRRIGFRAC_DRP (N)/2. DRATE(N,crop) = 0. endif if (I == 3)then - void_frac = FLOODFR (N)/2. + void_frac = IRRG_IRRIGFRAC_FRW (N)/2. FRATE(N,crop) = 0. endif else @@ -449,9 +457,9 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & END DO DO I = 1,3 if(I /= ABS(ITYPE))then - if (I == 1) SRATE (N,crop) = SRATE (N,crop)*(SPRINKLERFR(N) + void_frac) - if (I == 2) DRATE (N,crop) = DRATE (N,crop)*(DRIPFR (N) + void_frac) - if (I == 3) FRATE (N,crop) = FRATE (N,crop)*(FLOODFR (N) + void_frac) + if (I == 1) SRATE (N,crop) = SRATE (N,crop)*(IRRG_IRRIGFRAC_SPR(N) + void_frac) + if (I == 2) DRATE (N,crop) = DRATE (N,crop)*(IRRG_IRRIGFRAC_DRP (N) + void_frac) + if (I == 3) FRATE (N,crop) = FRATE (N,crop)*(IRRG_IRRIGFRAC_FRW (N) + void_frac) endif ENDDO @@ -465,7 +473,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & END DO CROP_LOOP ! turn off irrigation for crops that ended the season - DO crop = 1, NUM_CROPS + DO crop = 1, IRRG_NCROPS if(season_end(crop)) then SRATE (N,crop) = 0. DRATE (N,crop) = 0. @@ -480,19 +488,19 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & ! They are weighted averaged over 26 crop fractions. call this%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & - CROPIRRIGFRAC,SRATE,DRATE,FRATE) + IRRG_CROPIRRIGFRAC,SRATE,DRATE,FRATE) END SUBROUTINE irrigrate_crop_calendar ! ---------------------------------------------------------------------------- SUBROUTINE update_irates_lai (this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & - IRRIGFRAC,PADDYFRAC,SRATE,DRATE,FRATE) + IRRG_IRRIGFRAC,IRRG_PADDYFRAC,SRATE,DRATE,FRATE) implicit none class(irrigation_model),intent(inout):: this - real, dimension (:), intent (in) :: IRRIGFRAC, PADDYFRAC + real, dimension (:), intent (in) :: IRRG_IRRIGFRAC, IRRG_PADDYFRAC real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY integer :: N, NT @@ -503,12 +511,12 @@ SUBROUTINE update_irates_lai (this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRR IRRG_RATE_PDY = 0. IRRG_RATE_FRW = 0. - NT = size (IRRIGFRAC) + NT = size (IRRG_IRRIGFRAC) - !_ASSERT(size (SRATE,2)==NUM_CROPS,'Irrigation model LAI trigger irrig tile types mismatch') + !_ASSERT(size (SRATE,2)==IRRG_NCROPS,'Irrigation model LAI trigger irrig tile types mismatch') DO N = 1, NT - IF ((IRRIGFRAC(N) + PADDYFRAC(N)) > 0.) THEN + IF ((IRRG_IRRIGFRAC(N) + IRRG_PADDYFRAC(N)) > 0.) THEN IRRG_RATE_SPR (N) = SRATE (N,1) IRRG_RATE_DRP (N) = DRATE (N,1) IRRG_RATE_FRW (N) = FRATE (N,1) @@ -521,11 +529,11 @@ END SUBROUTINE update_irates_lai !............................................................................... SUBROUTINE update_irates_ccalendar(this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & - CROPIRRIGFRAC,SRATE,DRATE,FRATE) + IRRG_CROPIRRIGFRAC,SRATE,DRATE,FRATE) implicit none class(irrigation_model),intent(inout):: this - real, dimension(:,:), intent (in) :: CROPIRRIGFRAC ! NUM_CROPS + real, dimension(:,:), intent (in) :: IRRG_CROPIRRIGFRAC ! IRRG_NCROPS real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW integer :: N, NT, crop @@ -536,18 +544,18 @@ SUBROUTINE update_irates_ccalendar(this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PD IRRG_RATE_PDY = 0. IRRG_RATE_FRW = 0. - !_ASSERT(size (SRATE,2)==NUM_CROPS,'Irrigation model crop calandar trigger NUM_CROPS mismatch') + !_ASSERT(size (SRATE,2)==IRRG_NCROPS,'Irrigation model crop calendar trigger IRRG_NCROPS mismatch') NT = size (IRRG_RATE_SPR) DO N = 1, NT - if(SUM(CROPIRRIGFRAC(N,:)) > 0.) then - DO crop = 1, NUM_CROPS - IRRG_RATE_SPR(N) = IRRG_RATE_SPR(N) + SRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) - IRRG_RATE_DRP(N) = IRRG_RATE_DRP(N) + DRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + if(SUM(IRRG_CROPIRRIGFRAC(N,:)) > 0.) then + DO crop = 1, IRRG_NCROPS + IRRG_RATE_SPR(N) = IRRG_RATE_SPR(N) + SRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) + IRRG_RATE_DRP(N) = IRRG_RATE_DRP(N) + DRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) if (crop==3) then ! If crop is rice (crop ==3) then use flood irrigation. Otherwise use furrow irrigation. - IRRG_RATE_PDY(N) = IRRG_RATE_PDY(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + IRRG_RATE_PDY(N) = IRRG_RATE_PDY(N) + FRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) else - IRRG_RATE_FRW(N) = IRRG_RATE_FRW(N) + FRATE (N,crop)*CROPIRRIGFRAC(N,crop)/SUM(CROPIRRIGFRAC(N,:)) + IRRG_RATE_FRW(N) = IRRG_RATE_FRW(N) + FRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) endif END DO endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_wrap_state.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_wrap_state.F90 index cb9af81e0..8fc4c92f4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_wrap_state.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_wrap_state.F90 @@ -28,7 +28,7 @@ module catch_wrap_stateMod real :: SURFLAY real :: FWETC, FWETL logical :: USE_FWET_FOR_RUNOFF - integer :: RUN_IRRIG, IRRIG_METHOD + integer :: RUN_IRRIG, IRRG_METHOD end type T_CATCH_STATE type CATCH_WRAP @@ -79,7 +79,7 @@ subroutine surface_params_to_wrap_state(statePtr, scf, rc) call MAPL_GetResource( SCF, statePtr%N_CONST_LAND4SNWALB, label='N_CONST_LAND4SNWALB:', DEFAULT=0, __RC__ ) call MAPL_GetResource( SCF, statePtr%AEROSOL_DEPOSITION, label='AEROSOL_DEPOSITION:', DEFAULT=0, __RC__ ) call MAPL_GetResource( SCF, statePtr%RUN_IRRIG, label='RUN_IRRIG:', DEFAULT=0, __RC__ ) - call MAPL_GetResource( SCF, statePtr%IRRIG_METHOD, label='IRRIG_METHOD:', DEFAULT=0, __RC__ ) + call MAPL_GetResource( SCF, statePtr%IRRG_METHOD, label='IRRG_METHOD:', DEFAULT=0, __RC__ ) select type (statePtr) type is (T_CATCHCN_STATE) ! CATCHCN diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc index 5f3894bae..5469b0cce 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc @@ -170,39 +170,39 @@ # # ---- Irrigation trigger # -# 0 : (Default) LAI-based trigger turns irrigation on if LAI >= (LAImin + LAI_THRES * (LAImax - LAImin)) +# 0 : (Default) LAI-based trigger turns irrigation on if LAI >= (LAImin + IRRG_LAI_THRES * (LAImax - LAImin)) # 1 : Use planting and harvesting times from 26 crop calendars # -# GEOSagcm=>IRRIG_TRIGGER: 0 -# GEOSldas=>IRRIG_TRIGGER: 0 +# GEOSagcm=>IRRG_TRIGGER: 0 +# GEOSldas=>IRRG_TRIGGER: 0 # -# ---- Irrigation method (ONLY available with IRRIG_TRIGGER: 0) +# ---- Irrigation method (ONLY available with IRRG_TRIGGER: 0) # -# While the crop calendar based trigger uses crop-specific irrigation methods, the LAI-based trigger (IRRIG_TRIGGER: 0) offers below +# While the crop calendar based trigger uses crop-specific irrigation methods, the LAI-based trigger (IRRG_TRIGGER: 0) offers below # 4 different irrigation methods to choose from: # 0 : CONCURRENTLY Sprinkler, Flood, and DRIP irrigation methods on method specific tile fractions (default) # 1 : Sprinkler irrigation on entire tile # 2 : Drip irrigation on entire tile # 3 : Flood irrigation on entire tile # -# GEOSagcm=>IRRIG_METHOD: 0 -# GEOSldas=>IRRIG_METHOD: 0 +# GEOSagcm=>IRRG_METHOD: 0 +# GEOSldas=>IRRG_METHOD: 0 # # ----- Below default parameter values can also be changed via this resource file: # -# GEOSldas=>IRRIG_THRES: 0.01 # threshold of tile fraction to turn the irrigation model on. -# GEOSldas=>LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on -# GEOSldas=>SPRINKLER_STIME: 6.0 # sprinkler irrigatrion start time [hours] -# GEOSldas=>SPRINKLER_DUR: 4.0 # sprinkler irrigation duration [hours] -# GEOSldas=>SPRINKLER_THRES: 0.7 # soil moisture threshhold to trigger sprinkler irrigation -# GEOSldas=>DRIP_STIME: 8.0 # drip irrigatrion start time [hours] -# GEOSldas=>DRIP_DUR: 8.0 # drip irrigation duration [hours] -# GEOSldas=>FLOOD_STIME: 6.0 # flood irrigatrion start time [hours] -# GEOSldas=>FLOOD_DUR: 8.0 # flood irrigation duration [hours] -# GEOSldas=>FLOOD_THRES: 0.7 # soil moisture threshhold to trigger flood irrigation -# GEOSldas=>IRR_EFCOR: 25.0 # Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use ) -# GEOSldas=>MIDS_LENGTH: 0.6 # Mid-season length as a fraction of crop growing season length (to be used with IRRIG_TRIGGER : 1) -# # lengths of development and end seasons are assumed as (1 - MIDS_LENGTH) / 2. +# GEOSldas=>IRRG_FRAC_THRES: 0.01 # threshold of tile fraction to turn the irrigation model on. +# GEOSldas=>IRRG_LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on +# GEOSldas=>IRRG_SPR_STIME: 6.0 # sprinkler irrigatrion start time [hours] +# GEOSldas=>IRRG_SPR_DUR: 4.0 # sprinkler irrigation duration [hours] +# GEOSldas=>IRRG_SPR_THRES: 0.7 # soil moisture threshhold to trigger sprinkler irrigation IRRGRR: Units??? +# GEOSldas=>IRRG_DRP_STIME: 8.0 # drip irrigatrion start time [hours] +# GEOSldas=>IRRG_DRP_DUR: 8.0 # drip irrigation duration [hours] +# GEOSldas=>IRRG_FLD_STIME: 6.0 # flood irrigatrion start time [hours] +# GEOSldas=>IRRG_FLD_DUR: 8.0 # flood irrigation duration [hours] +# GEOSldas=>IRRG_FLD_THRES: 0.7 # soil moisture threshhold to trigger flood irrigation IRRGRR: Units??? +# GEOSldas=>IRR_EFCOR: 25.0 # Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use ) +# GEOSldas=>MIDS_LENGTH: 0.6 # Mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER : 1) +# # lengths of development and end seasons are assumed as (1 - MIDS_LENGTH) / 2. #--------------------------------------------------------# diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/clsm_plots.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/clsm_plots.pro index d5584b3dd..e827a676d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/clsm_plots.pro +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/clsm_plots.pro @@ -3102,9 +3102,9 @@ if file_test ('limits.idl') then restore,'limits.idl' id = NCDF_OPEN (filename, /NOWRITE) -NCDF_VARGET, id,'SPRINKLERFR',SPRINKLERV -NCDF_VARGET, id,'DRIPFR',DRIPV -NCDF_VARGET, id,'FLOODFR',FLOODV +NCDF_VARGET, id,'IRRG_IRRIGFRAC_SPR',SPRINKLERV +NCDF_VARGET, id,'IRRG_IRRIGFRAC_DRP',DRIPV +NCDF_VARGET, id,'IRRG_IRRIGFRAC_FRW',FLOODV NCDF_CLOSE, id @@ -3197,8 +3197,8 @@ if file_test ('limits.idl') then restore,'limits.idl' id = NCDF_OPEN (filename, /NOWRITE) -NCDF_VARGET, id,'LAIMIN',LAI_MNV -NCDF_VARGET, id,'LAIMAX',LAI_MXV +NCDF_VARGET, id,'IRRG_LAIMIN',LAI_MNV +NCDF_VARGET, id,'IRRG_LAIMAX',LAI_MXV NCDF_CLOSE, id @@ -3313,14 +3313,14 @@ if file_test ('limits.idl') then restore,'limits.idl' id = NCDF_OPEN (filename, /NOWRITE) -NCDF_VARGET, id,'IRRIGFRAC',IRRIGFRACV -NCDF_VARGET, id,'PADDYFRAC',PADDYFRACV +NCDF_VARGET, id,'IRRG_IRRIGFRAC',IRRIGFRAC_V +NCDF_VARGET, id,'IRRG_PADDYFRAC',IRRG_PADDYFRACV NCDF_VARGET, id,'RAINFEDFRAC',RAINFEDFRACV NCDF_CLOSE, id -IRRIGFRACV (where (IRRIGFRACV gt 1.)) = !VALUES.F_NAN -PADDYFRACV (where (PADDYFRACV gt 1.)) = !VALUES.F_NAN +IRRIGFRAC_V (where (IRRIGFRAC_V gt 1.)) = !VALUES.F_NAN +IRRG_PADDYFRACV (where (IRRG_PADDYFRACV gt 1.)) = !VALUES.F_NAN RAINFEDFRACV(where (RAINFEDFRACV gt 1.)) = !VALUES.F_NAN im = n_elements(tile_id[*,0]) @@ -3332,22 +3332,22 @@ dy = 180. / jm x = indgen(im)*dx -180. + dx/2. y = indgen(jm)*dy -90. + dy/2. -IRRIGFRAC = REPLICATE (!VALUES.F_NAN,IM, JM) -PADDYFRAC = REPLICATE (!VALUES.F_NAN,IM, JM) +IRRG_IRRIGFRAC = REPLICATE (!VALUES.F_NAN,IM, JM) +IRRG_PADDYFRAC = REPLICATE (!VALUES.F_NAN,IM, JM) RAINFEDFRAC = REPLICATE (!VALUES.F_NAN,IM, JM) for j = 0l, jm -1l do begin for i = 0l, im -1 do begin if(tile_id[i,j] gt 0) then begin - IRRIGFRAC (i,j) = IRRIGFRACV (tile_id[i,j] -1) - PADDYFRAC (i,j) = PADDYFRACV (tile_id[i,j] -1) + IRRG_IRRIGFRAC (i,j) = IRRIGFRAC_V (tile_id[i,j] -1) + IRRG_PADDYFRAC (i,j) = IRRG_PADDYFRACV (tile_id[i,j] -1) RAINFEDFRAC(i,j) = RAINFEDFRACV (tile_id[i,j] -1) endif endfor endfor -IRRIGFRAC (where (IRRIGFRAC eq 0.)) = !VALUES.F_NAN -PADDYFRAC (where (PADDYFRAC eq 0.)) = !VALUES.F_NAN +IRRG_IRRIGFRAC (where (IRRG_IRRIGFRAC eq 0.)) = !VALUES.F_NAN +IRRG_PADDYFRAC (where (IRRG_PADDYFRAC eq 0.)) = !VALUES.F_NAN RAINFEDFRAC(where (RAINFEDFRAC eq 0.)) = !VALUES.F_NAN colors = indgen (21) + 140 @@ -3404,10 +3404,10 @@ if file_test ('limits.idl') then restore,'limits.idl' id = NCDF_OPEN (filename, /NOWRITE) -NCDF_VARGET, id,'IRRIGPLANT',plantv -NCDF_VARGET, id,'IRRIGHARVEST',harvestv -NCDF_VARGET, id,'CROPIRRIGFRAC',Fracv -NCDF_VARGET, id,'IRRIGTYPE',irrigtypev +NCDF_VARGET, id,'IRRG_DOY_PLANT',plantv +NCDF_VARGET, id,'IRRG_DOY_HARVEST',harvestv +NCDF_VARGET, id,'IRRG_CROPIRRIGFRAC',Fracv +NCDF_VARGET, id,'IRRG_TYPE',IRRG_TYPE_V NCDF_VARGET, id,'CROPCLASSNAME',cropname NCDF_CLOSE, id @@ -3426,7 +3426,7 @@ y = fltarr (IM,JM) PLANT = REPLICATE (!VALUES.F_NAN,IM, JM, 2, 26) HARVEST = REPLICATE (!VALUES.F_NAN,IM, JM, 2, 26) FRAC = REPLICATE (!VALUES.F_NAN,IM, JM, 26) -IRRIGTYPE = REPLICATE (!VALUES.F_NAN,IM, JM, 26) +IRRG_TYPE = REPLICATE (!VALUES.F_NAN,IM, JM, 26) for j = 0l, jm -1l do begin for i = 0l, im -1 do begin @@ -3436,7 +3436,7 @@ for j = 0l, jm -1l do begin PLANT (i,j,*,*) = PLANTV (tile_id[i,j] -1,*,*) HARVEST (i,j,*,*) = HARVESTV (tile_id[i,j] -1,*,*) FRAC (i,j,*) = FRACV (tile_id[i,j] -1,*) - IRRIGTYPE(i,j,*) = IRRIGTYPEV (tile_id[i,j] -1,*) + IRRG_TYPE(i,j,*) = IRRG_TYPE_V (tile_id[i,j] -1,*) endif endfor endfor @@ -3544,7 +3544,7 @@ for n = 0, 25 do begin endif if (col eq 3) then begin - ptitle = ' : IRRIGTYPE' + ptitle = ' : IRRG_TYPE' data_grid = data4 endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 index af3e0e600..5fd2e12a8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -199,7 +199,7 @@ SUBROUTINE OpenFile status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'IRRIGFRAC' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_IRRIGFRAC' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of irrigated cropland'), & 'fraction of irrigated cropland') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -207,7 +207,7 @@ SUBROUTINE OpenFile status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'PADDYFRAC' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_PADDYFRAC' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of paddy cropland'), & 'fraction of paddy cropland') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -230,7 +230,7 @@ SUBROUTINE OpenFile status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Crop Class Name'), & 'Crop Class Name') ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'CROPIRRIGFRAC' , NF_FLOAT, 2 ,(/lid, cid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_CROPIRRIGFRAC' , NF_FLOAT, 2 ,(/lid, cid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Crop irrigated fraction'), & 'Crop irrigated fraction') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -249,13 +249,13 @@ SUBROUTINE OpenFile ! Crop calendar ! ------------- - status = NF_DEF_VAR(NCOutID, 'IRRIGPLANT' , NF_FLOAT, 3 ,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_DOY_PLANT' , NF_FLOAT, 3 ,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('DOY start planting'), & 'DOY start planting') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 4,'days') ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'IRRIGHARVEST' , NF_FLOAT, 3 ,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_DOY_HARVEST' , NF_FLOAT, 3 ,(/lid, mid, cid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('DOY end harvesting'), & 'DOY end harvesting') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 4,'days') ; VERIFY_(STATUS) @@ -276,14 +276,14 @@ SUBROUTINE OpenFile ! IRRIG TYPE ! ---------- - status = NF_DEF_VAR(NCOutID, 'IRRIGTYPE' , NF_FLOAT, 2 ,(/lid, cid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_TYPE' , NF_FLOAT, 2 ,(/lid, cid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', & LEN_TRIM('Preferred Irrig Type : Concurrent (0) SPRINKLER(1) DRIP(2) FLOOD(3) AVOID (negative)'), & 'Preferred Irrig Type : Concurrent (0) SPRINKLER(1) DRIP(2) FLOOD(3) AVOID (negative)') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'missing_value', NF_REAL,1, UNDEFG) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'SPRINKLERFR' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_IRRIGFRAC_SPR' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of sprinkler irrigation'), & 'fraction of sprinkler irrigation') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -291,7 +291,7 @@ SUBROUTINE OpenFile status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'DRIPFR' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_IRRIGFRAC_DRP' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of drip irrigation'), & 'fraction of drip irrigation') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -299,7 +299,7 @@ SUBROUTINE OpenFile status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'FLOODFR' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_IRRIGFRAC_FRW' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('fraction of flood irrigation'), & 'fraction of flood irrigation') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -309,7 +309,7 @@ SUBROUTINE OpenFile ! LAI ! --- - status = NF_DEF_VAR(NCOutID, 'LAIMIN' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_LAIMIN' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Minimum LAI irrigated crops'), & 'Minimum LAI irrigated crops') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -317,7 +317,7 @@ SUBROUTINE OpenFile status = NF_PUT_ATT_REAL(NCOutID, vid, 'add_offset', NF_REAL,1, 0.) ; VERIFY_(STATUS) status = NF_PUT_ATT_REAL(NCOutID, vid, 'scale_factor', NF_REAL,1, 1.) ; VERIFY_(STATUS) - status = NF_DEF_VAR(NCOutID, 'LAIMAX' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) + status = NF_DEF_VAR(NCOutID, 'IRRG_LAIMAX' , NF_FLOAT, 1 ,(/lid/), vid) ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'long_name', LEN_TRIM('Maximum LAI irrigated crops'), & 'Maximum LAI irrigated crops') ; VERIFY_(STATUS) status = NF_PUT_ATT_TEXT(NCOutID, vid, 'units', 1,'-') ; VERIFY_(STATUS) @@ -377,8 +377,8 @@ SUBROUTINE MergeData (NTILES) integer, dimension (12) :: DOY_MidMonth, DOY_BegMonth, DOY_EndMonth logical, dimension (4) :: found = .false. integer, allocatable , dimension (:) :: crop_mons - real, allocatable, dimension (:,:,:) :: IRRIGPLANT, IRRIGHARVEST, RAINFEDPLANT, RAINFEDHARVEST - real, allocatable, dimension (:,:) :: IRRIGTYPE + real, allocatable, dimension (:,:,:) :: IRRG_DOY_PLANT, IRRG_DOY_HARVEST, RAINFEDPLANT, RAINFEDHARVEST + real, allocatable, dimension (:,:) :: IRRG_TYPE data DOY_BegMonth / 1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335/ data DOY_MidMonth /15, 46, 74, 105, 135, 166, 196, 227, 258, 288, 319, 349/ @@ -419,22 +419,22 @@ SUBROUTINE MergeData (NTILES) ! rCrop | ! |-> NO Plant Wheat - allocate (MI (1 : NTILES, 1 : NCROPS)) - allocate (MR (1 : NTILES, 1 : NCROPS)) - allocate (IRRIGPLANT (1 : NTILES, 1 : 2, 1 : NCROPS)) - allocate (IRRIGHARVEST (1 : NTILES, 1 : 2, 1 : NCROPS)) - allocate (RAINFEDPLANT (1 : NTILES, 1 : 2, 1 : NCROPS)) - allocate (RAINFEDHARVEST (1 : NTILES, 1 : 2, 1 : NCROPS)) - allocate (IRRIGTYPE (1 : NTILES, 1 : NCROPS)) + allocate (MI (1 : NTILES, 1 : NCROPS)) + allocate (MR (1 : NTILES, 1 : NCROPS)) + allocate (IRRG_DOY_PLANT (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (IRRG_DOY_HARVEST (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (RAINFEDPLANT (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (RAINFEDHARVEST (1 : NTILES, 1 : 2, 1 : NCROPS)) + allocate (IRRG_TYPE (1 : NTILES, 1 : NCROPS)) MI = 0. MR = 0. - IRRIGTYPE = 0 + IRRG_TYPE = 0 - IRRIGPLANT = 998 - IRRIGHARVEST = 998 - RAINFEDPLANT = 998 - RAINFEDHARVEST = 998 + IRRG_DOY_PLANT = 998 + IRRG_DOY_HARVEST = 998 + RAINFEDPLANT = 998 + RAINFEDHARVEST = 998 ! Compute annual maximum fractions from MIRCA monthly fractions : ! (1) crop specific and (2) paddy and irrigated crops, seperately for rainfed and irrigated @@ -459,7 +459,7 @@ SUBROUTINE MergeData (NTILES) ! Crop planting/Harvesting days ! ----------------------------- - ! OUTPPUTS IRRIGPLANT, IRRIGHARVEST, RAINFEDPLANT, RAINFEDHARVEST + ! OUTPPUTS IRRG_DOY_PLANT, IRRG_DOY_HARVEST, RAINFEDPLANT, RAINFEDHARVEST forall (m=1:12) fmonth3(m) = m @@ -590,10 +590,10 @@ SUBROUTINE MergeData (NTILES) endif if (t == 1) then - IRRIGPLANT (I,1,N) = day1 - IRRIGPLANT (I,2,N) = day1_2 - IRRIGHARVEST (I,1,N) = dayL - IRRIGHARVEST (I,2,N) = dayL_2 + IRRG_DOY_PLANT (I,1,N) = day1 + IRRG_DOY_PLANT (I,2,N) = day1_2 + IRRG_DOY_HARVEST (I,1,N) = dayL + IRRG_DOY_HARVEST (I,2,N) = dayL_2 else RAINFEDPLANT (I,1,N) = day1 RAINFEDPLANT (I,2,N) = day1_2 @@ -606,8 +606,8 @@ SUBROUTINE MergeData (NTILES) END DO ! 1. Main Fractions (OUTPUT) : - ! 1.1 IRRIGFRAC : The maximum value between (1) GRIPC irrigfrac, and (2) sum of MIRCA monthly crop frations without rice - ! 1.2 PADDYFRAC : The maximum value between (1) GRIPC paddyfrac, and (2) monthly rice fractions from MIRCA + ! 1.1 IRRG_IRRIGFRAC : The maximum value between (1) GRIPC irrigfrac, and (2) sum of MIRCA monthly crop frations without rice + ! 1.2 IRRG_PADDYFRAC : The maximum value between (1) GRIPC paddyfrac, and (2) monthly rice fractions from MIRCA ! 1.3 RAINFEDFRAC : The maximum value between (1) GRIPC rainfedfrac, and (2) sum of MIRCA monthly crop frations ! 1.4 MI (I,CROPS) : Irrigated crop fractions with rice is the 3rd slice crops = 3 ! 1.5 MR (I,CROPS) : rainfed crop fractions with rice is the 3rd slice crops = 3 @@ -693,10 +693,10 @@ SUBROUTINE MergeData (NTILES) IF(N /= 3) THEN MI (I,N) = MR (I,N) * IGRIPC (I) / MRCROPA MR (I,N) = 0. - IRRIGPLANT (I,1,N) = RAINFEDPLANT (I,1,N) - IRRIGPLANT (I,2,N) = RAINFEDPLANT (I,2,N) - IRRIGHARVEST (I,1,N) = RAINFEDHARVEST (I,1,N) - IRRIGHARVEST (I,2,N) = RAINFEDHARVEST (I,2,N) + IRRG_DOY_PLANT (I,1,N) = RAINFEDPLANT (I,1,N) + IRRG_DOY_PLANT (I,2,N) = RAINFEDPLANT (I,2,N) + IRRG_DOY_HARVEST (I,1,N) = RAINFEDHARVEST (I,1,N) + IRRG_DOY_HARVEST (I,2,N) = RAINFEDHARVEST (I,2,N) ENDIF END DO ! CALL STOPIT (3, IGRIPC (I), MICROPA, MI (I,:)) @@ -706,10 +706,10 @@ SUBROUTINE MergeData (NTILES) ! MIRCA irrigated and rainfed do not have data plant some wheat MI (I,1) = IGRIPC (I) - IRRIGPLANT (I,1,1) = 999 - IRRIGPLANT (I,2,1) = 0 - IRRIGHARVEST (I,1,1) = 999 - IRRIGHARVEST (I,2,1) = 0 + IRRG_DOY_PLANT (I,1,1) = 999 + IRRG_DOY_PLANT (I,2,1) = 0 + IRRG_DOY_HARVEST (I,1,1) = 999 + IRRG_DOY_HARVEST (I,2,1) = 0 ! CALL STOPIT (4, IGRIPC (I), MICROPA, MI (I,:)) ENDIF ! ENDIF @@ -744,10 +744,10 @@ SUBROUTINE MergeData (NTILES) MI (I,3) = MR (I,3) * PGRIPC (I) / MRRICEA MR (I,3) = 0. MRRICEA = 0. - IRRIGPLANT (I,1,3) = RAINFEDPLANT (I,1,3) - IRRIGPLANT (I,2,3) = RAINFEDPLANT (I,2,3) - IRRIGHARVEST (I,1,3) = RAINFEDHARVEST (I,1,3) - IRRIGHARVEST (I,2,3) = RAINFEDHARVEST (I,2,3) + IRRG_DOY_PLANT (I,1,3) = RAINFEDPLANT (I,1,3) + IRRG_DOY_PLANT (I,2,3) = RAINFEDPLANT (I,2,3) + IRRG_DOY_HARVEST (I,1,3) = RAINFEDHARVEST (I,1,3) + IRRG_DOY_HARVEST (I,2,3) = RAINFEDHARVEST (I,2,3) ELSE ! MIRCA irrigated and rainfed do not have data plant rice to PGRIPC @@ -755,10 +755,10 @@ SUBROUTINE MergeData (NTILES) ! Get crop planting days for the nearest neighbor later - IRRIGPLANT (I,1,3) = 999 - IRRIGPLANT (I,2,3) = 0 - IRRIGHARVEST (I,1,3) = 999 - IRRIGHARVEST (I,2,3) = 0 + IRRG_DOY_PLANT (I,1,3) = 999 + IRRG_DOY_PLANT (I,2,3) = 0 + IRRG_DOY_HARVEST (I,1,3) = 999 + IRRG_DOY_HARVEST (I,2,3) = 0 ENDIF ENDIF @@ -800,7 +800,7 @@ SUBROUTINE MergeData (NTILES) ENDIF ! ENDIF - ! IRRIGTYPE + ! IRRG_TYPE DO N = 1, NCROPS FF = FLOOD (I) @@ -810,14 +810,14 @@ SUBROUTINE MergeData (NTILES) SF = 0. DF = 0. FF = 1. - IRRIGTYPE (I, N) = 3 ! Always flood + IRRG_TYPE (I, N) = 3 ! Always flood ENDIF - IF(N == 10) IRRIGTYPE (I, N) = -1 ! never sprinkler - IF(N == 22) IRRIGTYPE (I, N) = -1 ! never sprinkler + IF(N == 10) IRRG_TYPE (I, N) = -1 ! never sprinkler + IF(N == 22) IRRG_TYPE (I, N) = -1 ! never sprinkler !IF(N == 10) SF = 0. ! Date palm !IF(N == 22) SF = 0. ! Cocoa !ITYPE = (/SF, DF, FF/) - !IRRIGTYPE (I, N) = maxloc(ITYPE, 1) + !IRRG_TYPE (I, N) = maxloc(ITYPE, 1) END DO ENDIF END DO @@ -831,14 +831,14 @@ SUBROUTINE MergeData (NTILES) ! fill missing crop plant/harvest DOYs in irrigated crops ! ....................................................... - IF((IRRIGPLANT(I,1,N) == 999).AND.(MI (I,N) > 0.)) THEN - l = getNeighbor (I,day_in = IRRIGPLANT (:,1,N)) - IRRIGPLANT (I,1,N) = IRRIGPLANT (l,1,N) - IRRIGHARVEST(I,1,N) = IRRIGHARVEST(l,1,N) + IF((IRRG_DOY_PLANT(I,1,N) == 999).AND.(MI (I,N) > 0.)) THEN + l = getNeighbor (I,day_in = IRRG_DOY_PLANT (:,1,N)) + IRRG_DOY_PLANT (I,1,N) = IRRG_DOY_PLANT (l,1,N) + IRRG_DOY_HARVEST(I,1,N) = IRRG_DOY_HARVEST(l,1,N) if(N == 1) then IF(RAINFEDPLANT(I,1,N) == 999) THEN - RAINFEDPLANT (I,1,N) = IRRIGPLANT (l,1,N) - RAINFEDHARVEST(I,1,N) = IRRIGHARVEST(l,1,N) + RAINFEDPLANT (I,1,N) = IRRG_DOY_PLANT (l,1,N) + RAINFEDHARVEST(I,1,N) = IRRG_DOY_HARVEST(l,1,N) ENDIF endif endif @@ -847,38 +847,38 @@ SUBROUTINE MergeData (NTILES) ! fill missing crop plant/harvest DOYs in rainfed crops ! ..................................................... ! temperorily commented out to save time, because we don't irrigate here anyway - ! IF((RAINFEDPLANT(I,1,N) == 999).AND.(MR (I,N) > 0.)) THEN - ! print *,'RAINFEDPLANT(I,1,N)',I,N, MR (I,N) - ! l = getNeighbor (I,day_in = IRRIGPLANT (:,1,N)) - ! RAINFEDPLANT (I,1,N) = IRRIGPLANT (l,1,N) - ! RAINFEDHARVEST(I,1,N) = IRRIGHARVEST(l,1,N) - ! endif + ! IF((RAINFEDPLANT(I,1,N) == 999).AND.(MR (I,N) > 0.)) THEN + ! print *,'RAINFEDPLANT(I,1,N)',I,N, MR (I,N) + ! l = getNeighbor (I,day_in = IRRG_DOY_PLANT (:,1,N)) + ! RAINFEDPLANT (I,1,N) = IRRG_DOY_PLANT (l,1,N) + ! RAINFEDHARVEST(I,1,N) = IRRG_DOY_HARVEST(l,1,N) + ! endif ENDIF END DO - if(((IRRIGPLANT (I,1,1) == 999).and.(MI (i,1) > 0.)).OR. & - ((IRRIGPLANT (I,1,3) == 999).and.(MI (i,3) > 0.))) then - print *, i, IRRIGPLANT (I,1,1:3), MI (i,1:3) + if( ((IRRG_DOY_PLANT (I,1,1) == 999).and.(MI (i,1) > 0.)) .OR. & + ((IRRG_DOY_PLANT (I,1,3) == 999).and.(MI (i,3) > 0.)) ) then + print *, i, IRRG_DOY_PLANT (I,1,1:3), MI (i,1:3) stop endif END DO - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGFRAC' ) ,(/1/),(/NTILES/),IGRIPC ) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'PADDYFRAC' ) ,(/1/),(/NTILES/),PGRIPC ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_IRRIGFRAC' ) ,(/1/),(/NTILES/),IGRIPC ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_PADDYFRAC' ) ,(/1/),(/NTILES/),PGRIPC ) ; VERIFY_(STATUS) status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDFRAC') ,(/1/),(/NTILES/),RGRIPC ) ; VERIFY_(STATUS) do n = 1,NCROPS - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'CROPIRRIGFRAC' ) ,(/1,n/),(/NTILES,1/),MI (:,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'CROPRAINFEDFRAC') ,(/1,n/),(/NTILES,1/),MR (:,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGTYPE' ) ,(/1,n/),(/NTILES,1/),IRRIGTYPE (:,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGPLANT' ) ,(/1,1,n/),(/NTILES,1,1/), IRRIGPLANT (:,1,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGPLANT' ) ,(/1,2,n/),(/NTILES,1,1/), IRRIGPLANT (:,2,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGHARVEST' ) ,(/1,1,n/),(/NTILES,1,1/), IRRIGHARVEST(:,1,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRIGHARVEST' ) ,(/1,2,n/),(/NTILES,1,1/), IRRIGHARVEST(:,2,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_CROPIRRIGFRAC' ) ,(/1,n /),(/NTILES,1 /), MI (:,n) ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'CROPRAINFEDFRAC' ) ,(/1,n /),(/NTILES,1 /), MR (:,n) ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_TYPE' ) ,(/1,n /),(/NTILES,1 /), IRRG_TYPE (:,n) ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_DOY_PLANT' ) ,(/1,1,n/),(/NTILES,1,1/), IRRG_DOY_PLANT (:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_DOY_PLANT' ) ,(/1,2,n/),(/NTILES,1,1/), IRRG_DOY_PLANT (:,2,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_DOY_HARVEST' ) ,(/1,1,n/),(/NTILES,1,1/), IRRG_DOY_HARVEST(:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_DOY_HARVEST' ) ,(/1,2,n/),(/NTILES,1,1/), IRRG_DOY_HARVEST(:,2,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDPLANT' ) ,(/1,1,n/),(/NTILES,1,1/), RAINFEDPLANT (:,1,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDPLANT' ) ,(/1,2,n/),(/NTILES,1,1/), RAINFEDPLANT (:,2,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDHARVEST' ) ,(/1,1,n/),(/NTILES,1,1/), RAINFEDHARVEST(:,1,n)) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDHARVEST' ) ,(/1,2,n/),(/NTILES,1,1/), RAINFEDHARVEST(:,2,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDPLANT' ) ,(/1,1,n/),(/NTILES,1,1/), RAINFEDPLANT (:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDPLANT' ) ,(/1,2,n/),(/NTILES,1,1/), RAINFEDPLANT (:,2,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDHARVEST' ) ,(/1,1,n/),(/NTILES,1,1/), RAINFEDHARVEST (:,1,n)) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'RAINFEDHARVEST' ) ,(/1,2,n/),(/NTILES,1,1/), RAINFEDHARVEST (:,2,n)) ; VERIFY_(STATUS) end do status = NF_CLOSE(NCOutID) @@ -1006,9 +1006,9 @@ SUBROUTINE ReadProcess_IMethod (NTILES, f_sprink, f_drip, f_flood) CALL update_IMethod_bycounty (NTILES, f_sprink, f_drip, f_flood) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'SPRINKLERFR') ,(/1/),(/NTILES/), f_sprink) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'DRIPFR' ) ,(/1/),(/NTILES/), f_drip ) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'FLOODFR' ) ,(/1/),(/NTILES/), f_flood ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_IRRIGFRAC_SPR') ,(/1/),(/NTILES/), f_sprink) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_IRRIGFRAC_DRP' ) ,(/1/),(/NTILES/), f_drip ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_IRRIGFRAC_FRW' ) ,(/1/),(/NTILES/), f_flood ) ; VERIFY_(STATUS) print *, 'DONE PROCESSING IRRIGATION METHOD DATA ' @@ -1045,9 +1045,9 @@ SUBROUTINE update_IMethod_bycounty (NTILES, f_sprink, f_drip, f_flood) status = NF_GET_VARA_INT(NCID,VarID(NCID,'POLYID') ,(/1,j/),(/NX_cb, 1/), POLYID (:,NY_cb - j + 1)) ; VERIFY_(STATUS) ! reading north to south end do do j = 1, cb_states - status = NF_GET_VARA_REAL(NCID,VarID(NCID,'SPRINKLERFR') ,(/1,j/),(/cb_county, 1/), SFR (:,j)) ; VERIFY_(STATUS) - status = NF_GET_VARA_REAL(NCID,VarID(NCID,'DRIPFR' ) ,(/1,j/),(/cb_county, 1/), DFR (:,j)) ; VERIFY_(STATUS) - status = NF_GET_VARA_REAL(NCID,VarID(NCID,'FLOODFR' ) ,(/1,j/),(/cb_county, 1/), FFR (:,j)) ; VERIFY_(STATUS) + status = NF_GET_VARA_REAL(NCID,VarID(NCID,'IRRG_IRRIGFRAC_SPR') ,(/1,j/),(/cb_county, 1/), SFR (:,j)) ; VERIFY_(STATUS) + status = NF_GET_VARA_REAL(NCID,VarID(NCID,'IRRG_IRRIGFRAC_DRP' ) ,(/1,j/),(/cb_county, 1/), DFR (:,j)) ; VERIFY_(STATUS) + status = NF_GET_VARA_REAL(NCID,VarID(NCID,'IRRG_IRRIGFRAC_FRW' ) ,(/1,j/),(/cb_county, 1/), FFR (:,j)) ; VERIFY_(STATUS) end do status = NF_GET_VARA_INT(NCID,VarID(NCID,'GEOID' ) ,(/1/),(/cb_countyUS/), GEOID) ; VERIFY_(STATUS) status = NF_CLOSE(NCID) ; VERIFY_(STATUS) @@ -1350,8 +1350,8 @@ SUBROUTINE ReadProcess_GRIPC (NC, NR, NTILES, tile_id,IGRIPC, RGRIPC, PGRIPC, NG close (43) where (LAI_MIN == 9999.) LAI_MIN=-9999. - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'LAIMAX' ) ,(/1/),(/NTILES/),LAI_MAX ) ; VERIFY_(STATUS) - status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'LAIMIN' ) ,(/1/),(/NTILES/),LAI_MIN ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_LAIMAX' ) ,(/1/),(/NTILES/),LAI_MAX ) ; VERIFY_(STATUS) + status = NF_PUT_VARA_REAL(NCOutID,VarID(NCOutID,'IRRG_LAIMIN' ) ,(/1/),(/NTILES/),LAI_MIN ) ; VERIFY_(STATUS) deallocate (var_in, iraster, min_cnt, max_cnt, tot_cnt, LAI_MIN, LAI_MAX, lai, yr, mn, dy, dum, nt) @@ -1556,7 +1556,9 @@ integer function getNeighbor (tid_in, lai_in, day_in) end function getNeighbor ! ***************************************************************************** - + + ! IRRGRR - duplicates same in Utils/mk_restarts/getids.F90 + function to_radian(degree) result(rad) real,intent(in) :: degree @@ -1567,6 +1569,8 @@ function to_radian(degree) result(rad) end function to_radian ! ***************************************************************************** + + ! IRRGRR - duplicates same in Utils/mk_restarts/getids.F90 real function haversine(deglat1,deglon1,deglat2,deglon2) ! great circle distance -- adapted from Matlab From 43167ab8b656f6b0f8204272ac51c320645fc2a2 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 8 Feb 2025 17:52:33 -0500 Subject: [PATCH 32/55] bug fix in handling of irrigation parameter MIDS_LENGTH (irrigation_model.F90) --- .../GEOSirrigation_GridComp/irrigation_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index a8f23d7a0..8ab354987 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -205,7 +205,7 @@ SUBROUTINE init_model (IP, SURFRC) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_THRES:' , VALUE=IP%flood_thres, DEFAULT=DP%flood_thres , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRR_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_LAI_THRES:' , VALUE=IP%lai_thres, DEFAULT=DP%lai_thres , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='MIDS_LENGTH:' , VALUE=IP%MIDS_LENGTH, DEFAULT=DP%lai_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='MIDS_LENGTH:' , VALUE=IP%MIDS_LENGTH, DEFAULT=DP%MIDS_LENGTH , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FRAC_THRES:', VALUE=IP%irrig_thres, DEFAULT=DP%irrig_thres , __RC__ ) CALL ESMF_ConfigDestroy (SCF, __RC__) From 97ca01396b5fd00f243eb94aecd10dfe0724907b Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 8 Feb 2025 18:00:10 -0500 Subject: [PATCH 33/55] avoid duplicate hardwiring of NCROPS parameter (module_irrig_params.F90) --- .../Utils/Raster/makebcs/module_irrig_params.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 index 5fd2e12a8..e3b361a65 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/module_irrig_params.F90 @@ -8,6 +8,7 @@ module module_irrig_params use rmTinyCatchParaMod, ONLY : RegridRaster,regridrasterreal use process_hres_data, ONLY : get_country_codes use MAPL + use irrigation_module, ONLY : NCROPS => IRRG_NCROPS implicit none @@ -40,7 +41,7 @@ subroutine create_irrig_params (nc, nr, gfile) integer, parameter :: NX_mirca = 4320 integer, parameter :: NY_mirca = 2160 - integer, parameter :: NCROPS = 26, NMON = 12, STRLEN = 20 + integer, parameter :: NMON = 12, STRLEN = 20 real, parameter :: DXY_mirca= 360./REAL(NX_mirca) real, parameter :: lat1_mirca = 90.0 - DXY_mirca / 2.0 !1st grid center lat real, parameter :: lon1_mirca = -180.0 + DXY_mirca / 2.0 !1st grid center lon From fb65cfe0c452c04a6518981b339fe97edea84e93 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sun, 9 Feb 2025 07:01:26 -0500 Subject: [PATCH 34/55] fixed build error from previous commit (GEOS_IrrigationGridComp.F90) --- .../GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 | 2 +- .../GEOSirrigation_GridComp/irrigation_model.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index b20df2fac..b49bcdbab 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -575,7 +575,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! which IRRG_IRRIGFRAC and IRRG_PADDYFRAC in BCs are fractions. ! The irrigation model would run on tiles with IRRG_IRRIGFRAC + IRRG_PADDYFRAC > IRRG_FRAC_THRES (default is 0.01). - where (IRRG_IRRIGFRAC + IRRG_PADDYFRAC > IM%IRRG_FRAC_THRES) + where (IRRG_IRRIGFRAC + IRRG_PADDYFRAC > IM%irrig_thres) ! uncomment the following block to assign the entire cell to the largest fraction: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 8ab354987..84346fc77 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -203,9 +203,9 @@ SUBROUTINE init_model (IP, SURFRC) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_STIME:' , VALUE=IP%flood_stime, DEFAULT=DP%flood_stime , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_DUR:' , VALUE=IP%flood_dur, DEFAULT=DP%flood_dur , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_THRES:' , VALUE=IP%flood_thres, DEFAULT=DP%flood_thres , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='IRR_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRR_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) ! IRRGRR - revise rc param name CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_LAI_THRES:' , VALUE=IP%lai_thres, DEFAULT=DP%lai_thres , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='MIDS_LENGTH:' , VALUE=IP%MIDS_LENGTH, DEFAULT=DP%MIDS_LENGTH , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='MIDS_LENGTH:' , VALUE=IP%MIDS_LENGTH, DEFAULT=DP%MIDS_LENGTH , __RC__ ) ! IRRGRR - revise rc param name CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FRAC_THRES:', VALUE=IP%irrig_thres, DEFAULT=DP%irrig_thres , __RC__ ) CALL ESMF_ConfigDestroy (SCF, __RC__) From 0fab87e261e1f5b542286896f24ca19d2ca40186 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sun, 9 Feb 2025 11:29:47 -0500 Subject: [PATCH 35/55] attempt to have makebcs see GEOS_Irrigation lib --- .../GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt | 2 +- .../GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt index 5bc517e1e..f4879226a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt @@ -1,4 +1,4 @@ -esma_set_this () +esma_set_this (OVERRIDE GEOS_Irrigation) set (srcs GEOS_IrrigationGridComp.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt index e55ea1685..5b2bd815d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt @@ -19,7 +19,7 @@ endif () set_source_files_properties(mkMITAquaRaster.F90 PROPERTIES COMPILE_FLAGS "${BYTERECLEN}") -esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared ESMF::ESMF NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran) +esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared GEOS_Irrigation ESMF::ESMF NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran) if(NOT FORTRAN_COMPILER_SUPPORTS_FINDLOC) target_compile_definitions(${this} PRIVATE USE_EXTERNAL_FINDLOC) From 9803b4d77e70aa6b5298b3b3685c50471b621298 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sun, 9 Feb 2025 12:09:46 -0500 Subject: [PATCH 36/55] another attempt at CMake connections for irrigation --- .../GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt | 2 +- .../GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt index f4879226a..5bc517e1e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/CMakeLists.txt @@ -1,4 +1,4 @@ -esma_set_this (OVERRIDE GEOS_Irrigation) +esma_set_this () set (srcs GEOS_IrrigationGridComp.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt index 5b2bd815d..706d3cf82 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt @@ -19,7 +19,7 @@ endif () set_source_files_properties(mkMITAquaRaster.F90 PROPERTIES COMPILE_FLAGS "${BYTERECLEN}") -esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared GEOS_Irrigation ESMF::ESMF NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran) +esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared GEOSirrigation_GridComp ESMF::ESMF NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran) if(NOT FORTRAN_COMPILER_SUPPORTS_FINDLOC) target_compile_definitions(${this} PRIVATE USE_EXTERNAL_FINDLOC) From 28f03743a57613fb227a54d2eb9c4e9d38d36fd2 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Mon, 24 Feb 2025 10:19:33 -0500 Subject: [PATCH 37/55] fixed indent, only white-space changes (mkCatchParam.F90) --- .../Utils/Raster/makebcs/mkCatchParam.F90 | 1041 ++++++++--------- 1 file changed, 520 insertions(+), 521 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index 68b2b3649..2f6668dbe 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -205,122 +205,143 @@ PROGRAM mkCatchParam if (trim(SNOWALB)=='MODC061' .or. trim(SNOWALB) =='MODC061v2') process_snow_albedo=.true. -! if(n_threads == 1) then - - write (log_file,'(a)')trim(LAIBCS) - write (log_file,'(a)')trim(MODALB) - write (log_file,'(a)')trim(SOILBCS) - write (log_file,'(a)')trim(SNOWALB) - write (log_file,'(a)')trim(MaskFile) - write (log_file,'(a)')trim(PEATSOURCE) - write (log_file,'(a)')trim(VEGZSOURCE) - write (log_file,'(a)')' ' - write (log_file,'(a)')'============================================================' - write (log_file,'(a)')'............ Begin CLSM parameter generation:...............' - write (log_file,'(a)')' ' - write (log_file,'(a)')'CLSM parameters are being generated for the tile space :' - write (log_file,'(a)')' ',trim(fnameTil) - write (log_file,'(a)')' ' - write (log_file,'(a)')'============================================================' - write (log_file,'(a)')' ' - - if(index(Gridname,'CF')/=0) then - DL = 'DE' - write (log_file,'(a)')'Cube-Sphere Grid - assuming dateline-on-edge (DE)' - endif - - ! ****************************************************************************** - ! - ! IMPORTANT: The top-level make_bcs script should not allow this program to - ! run when ./clsm/ exists. Consequently, across "Steps [xx]" below, - ! the "inquire()" statements should be obsolete, and the case - ! "Using existing file" should never happen. - ! - ! ****************************************************************************** + ! if(n_threads == 1) then + + write (log_file,'(a)')trim(LAIBCS) + write (log_file,'(a)')trim(MODALB) + write (log_file,'(a)')trim(SOILBCS) + write (log_file,'(a)')trim(SNOWALB) + write (log_file,'(a)')trim(MaskFile) + write (log_file,'(a)')trim(PEATSOURCE) + write (log_file,'(a)')trim(VEGZSOURCE) + write (log_file,'(a)')' ' + write (log_file,'(a)')'============================================================' + write (log_file,'(a)')'............ Begin CLSM parameter generation:...............' + write (log_file,'(a)')' ' + write (log_file,'(a)')'CLSM parameters are being generated for the tile space :' + write (log_file,'(a)')' ',trim(fnameTil) + write (log_file,'(a)')' ' + write (log_file,'(a)')'============================================================' + write (log_file,'(a)')' ' + + if(index(Gridname,'CF')/=0) then + DL = 'DE' + write (log_file,'(a)')'Cube-Sphere Grid - assuming dateline-on-edge (DE)' + endif - allocate(tile_id(nc, nr)) - fname_tmp = trim(fnameRst)//'.rst' - open (newunit=unit,file=fname_tmp,status='old',action='read',form='unformatted',convert='little_endian', IOSTAT=status) - if (status /=0) then - write (log_file,'(a)')' '//trim(fname_tmp) // 'cannot be opened, exit ' - call exit(1) - endif - do j = 1, nr - read(unit)tile_id(:,j) - end do - close(unit) - ! Creating catchment.def - ! ---------------------- - - tmpstring = 'Step 01: Supplemental tile attributes and nc4-formatted tile file' - fname_tmp = 'clsm/catchment.def' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - if(.not.ease_grid) then - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating catchment def and nc4 tile file...' - call system_clock(clock1) - call supplemental_tile_attributes(nc,nr,regrid,dl,fnameTil, tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')' Using existing file.' - endif - else - write (log_file,'(a)')'Skipping step for EASE grid. ' - write (log_file,'(a)')'catchment.def file and tile file should already be created by mkEASETilesParam.x ' + ! ****************************************************************************** + ! + ! IMPORTANT: The top-level make_bcs script should not allow this program to + ! run when ./clsm/ exists. Consequently, across "Steps [xx]" below, + ! the "inquire()" statements should be obsolete, and the case + ! "Using existing file" should never happen. + ! + ! ****************************************************************************** + + allocate(tile_id(nc, nr)) + fname_tmp = trim(fnameRst)//'.rst' + open (newunit=unit,file=fname_tmp,status='old',action='read',form='unformatted',convert='little_endian', IOSTAT=status) + if (status /=0) then + write (log_file,'(a)')' '//trim(fname_tmp) // 'cannot be opened, exit ' + call exit(1) + endif + do j = 1, nr + read(unit)tile_id(:,j) + end do + close(unit) + ! Creating catchment.def + ! ---------------------- + + tmpstring = 'Step 01: Supplemental tile attributes and nc4-formatted tile file' + fname_tmp = 'clsm/catchment.def' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + if(.not.ease_grid) then + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating catchment def and nc4 tile file...' + call system_clock(clock1) + call supplemental_tile_attributes(nc,nr,regrid,dl,fnameTil, tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' endif - write (log_file,'(a)')' ' + else + write (log_file,'(a)')'Skipping step for EASE grid. ' + write (log_file,'(a)')'catchment.def file and tile file should already be created by mkEASETilesParam.x ' + endif + write (log_file,'(a)')' ' - call ReadTilingNC4( trim(fnameTil)//".nc4", iTable = iTable) - N_land = count(iTable(:,0) == 100) ! n_land = number of land tiles - allocate(tile_j_dum, source = iTable(1:n_land,7)) ! possible used in cti_stats.dat - deallocate (iTable) - - ! reading from catchment to preserve zero-diff - open (newunit=unit,file='clsm/catchment.def',status='old',action='read',form='formatted', IOSTAT=status) - if (status /=0) then - write (log_file,'(a)')' clsm/cathment.def cannot be opened, exit ' - call exit(1) - endif - read(unit,*) N - if (n /= n_land) then - write (log_file,'(a)')'n_land not consistent between tile file and catchment.def file, exit ' - write (log_file,*) n_land, n - call exit(1) - endif + call ReadTilingNC4( trim(fnameTil)//".nc4", iTable = iTable) + N_land = count(iTable(:,0) == 100) ! n_land = number of land tiles + allocate(tile_j_dum, source = iTable(1:n_land,7)) ! possible used in cti_stats.dat + deallocate (iTable) - allocate(min_lon(n_land), max_lon(n_land), min_lat(n_land), max_lat(n_land)) - allocate(tile_lat(n_land), tile_lon(n_land)) - allocate(tile_pfs(n_land)) - - do n = 1, N_land - read (unit,*) tindex1,pfaf1,minlon,maxlon,minlat,maxlat, elev - min_lon(n) = minlon - max_lon(n) = maxlon - min_lat(n) = minlat - max_lat(n) = maxlat - tile_lon(n)= (minlon + maxlon)/2.0 - tile_lat(n)= (minlat + maxlat)/2.0 - tile_pfs(n)= pfaf1 - end do - close (unit,status='keep') + ! reading from catchment to preserve zero-diff + open (newunit=unit,file='clsm/catchment.def',status='old',action='read',form='formatted', IOSTAT=status) + if (status /=0) then + write (log_file,'(a)')' clsm/cathment.def cannot be opened, exit ' + call exit(1) + endif + read(unit,*) N + if (n /= n_land) then + write (log_file,'(a)')'n_land not consistent between tile file and catchment.def file, exit ' + write (log_file,*) n_land, n + call exit(1) + endif + + allocate(min_lon(n_land), max_lon(n_land), min_lat(n_land), max_lat(n_land)) + allocate(tile_lat(n_land), tile_lon(n_land)) + allocate(tile_pfs(n_land)) + + do n = 1, N_land + read (unit,*) tindex1,pfaf1,minlon,maxlon,minlat,maxlat, elev + min_lon(n) = minlon + max_lon(n) = maxlon + min_lat(n) = minlat + max_lat(n) = maxlat + tile_lon(n)= (minlon + maxlon)/2.0 + tile_lat(n)= (minlat + maxlat)/2.0 + tile_pfs(n)= pfaf1 + end do + close (unit,status='keep') + + inquire(file='clsm/catch_params.nc4', exist=file_exists) + if (.not.file_exists) CALL open_landparam_nc4_files(N_land,process_snow_albedo) + + ! Creating cti_stats.dat + ! ---------------------- + + tmpstring = 'Step 02: Compound Topographic Index (CTI) stats' + fname_tmp = 'clsm/cti_stats.dat' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file...' + call system_clock(clock1) + call cti_stat_file (MaskFile, n_land, tile_pfs, tile_j_dum) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' + endif + write (log_file,'(a)')' ' - inquire(file='clsm/catch_params.nc4', exist=file_exists) - if (.not.file_exists) CALL open_landparam_nc4_files(N_land,process_snow_albedo) + ! Creating vegetation classification files + !----------------------------------------- - ! Creating cti_stats.dat - ! ---------------------- + if (index(MaskFile,'GEOS5_10arcsec_mask') /= 0) then - tmpstring = 'Step 02: Compound Topographic Index (CTI) stats' - fname_tmp = 'clsm/cti_stats.dat' + tmpstring = 'Step 03: Vegetation types using ESA land cover (MOSAIC/Catch)' + fname_tmp = 'clsm/mosaic_veg_typs_fracs' write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' inquire(file=trim(fname_tmp), exist=file_exists) if (.not.file_exists) then write (log_file,'(a)')' Creating file...' call system_clock(clock1) - call cti_stat_file (MaskFile, n_land, tile_pfs, tile_j_dum) + call ESA2MOSAIC (nc,nr, n_land, tile_pfs, tile_id) call system_clock(clock2) seconds = (clock2-clock1)/real(clock_rate) write (log_file, *) ' Done. Spent ', seconds, " seconds" @@ -328,473 +349,452 @@ PROGRAM mkCatchParam write (log_file,'(a)')' Using existing file.' endif write (log_file,'(a)')' ' - - ! Creating vegetation classification files - !----------------------------------------- - - if (index(MaskFile,'GEOS5_10arcsec_mask') /= 0) then - - tmpstring = 'Step 03: Vegetation types using ESA land cover (MOSAIC/Catch)' - fname_tmp = 'clsm/mosaic_veg_typs_fracs' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - call ESA2MOSAIC (nc,nr, n_land, tile_pfs, tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')' Using existing file.' - endif - write (log_file,'(a)')' ' - - tmpstring = 'Step 04: Vegetation types using ESA land cover (CatchCNCLM40)' - fname_tmp = 'clsm/CLM_veg_typs_fracs' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - call ESA2CLM (nc,nr, n_land, tile_lat, tile_pfs, tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')' Using existing file.' - endif - write (log_file,'(a)')' ' - else - - tmpstring = 'Step 03: Vegetation types using IGBP SiB2 land cover (MOSAIC/Catch)' - fname_tmp = 'clsm/mosaic_veg_typs_fracs' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - call compute_mosaic_veg_types (nc, nr, regrid, n_land, tile_pfs, tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')' Using existing file.' - endif - write (log_file,'(a)')' ' - - ! Per make_bcs, it looks like there are four possible mask files: - ! - ! GEOS5_10arcsec_mask.nc - ! global.cat_id.catch.DL - ! global.cat_id.catch.GreatLakesCaspian_Updated.DL - ! GEOS5_10arcsec_mask_freshwater-lakes.nc - ! - ! If we are in this else block, we must be using one of the latter three masks. - ! It looks like these latter masks only work for Catchment and not CatchCNCLM[xx] - ! - ! - reichle, 11 Jan 2022 - - write (log_file,'(a)')'NOTE: The selected mask works only for the Catchment model.' - write (log_file,'(a)')' Vegetation types *not* created for CatchCNCLM[xx].' - write (log_file,'(a)')' SKIPPING Step 04 and Step 05 !!!' - write (log_file,'(a)')' ' - - endif - - ! Processing Vegetation Climatology - ! --------------------------------- - - ! creating mapping arrays if necessary - - tmpstring = 'Step 05: Vegetation climatologies' - write (log_file,'(a,a,a)') trim(tmpstring),' ', trim(LAIBCS) - - if((trim(LAIBCS) == 'MODGEO').or.(trim(LAIBCS) == 'GEOLAND2')) then - fname_tmp = 'clsm/lai.GEOLAND2_10-DayClim' - write (log_file,'(a,a)')' --> ', trim(fname_tmp) - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file...' - !allocate (mapgeoland2 (1:40320,1:20160)) - call system_clock(clock1) - call create_mapping (nc,nr,40320,20160,mapgeoland2, n_land, tile_id ) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done create mapping mapgeoland2. Spent ', seconds, " seconds" - lai_name = 'GEOLAND2_10-DayClim/geoland2_' - - write (log_file,'(a)')' Creating '//lai_name - call system_clock(clock1) - if(trim(LAIBCS) == 'GEOLAND2') then - call hres_lai_no_gswp (40320,20160,mapgeoland2, lai_name, n_land, tile_lon, tile_lat) - else - call hres_lai_no_gswp (40320,20160,mapgeoland2, lai_name, n_land, tile_lon, tile_lat, merge=1) - endif - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - ! if(allocated(mapgeoland2)) deallocate (mapgeoland2) - deallocate (mapgeoland2%map) - deallocate (mapgeoland2%ij_index) - write (log_file,'(a)')' Done.' - else - write (log_file,'(a)')' Using existing file.' - endif - endif - - if ((LAIBCS == 'MODGEO').or.(LAIBCS == 'MODIS').or.(MODALB == 'MODIS2')) then - ! allocate (maparc30 (1:43200,1:21600)) - call system_clock(clock1) - call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done create mapping maparc30. Spent ', seconds, " seconds" - endif - - fname_tmp = 'clsm/green.dat' - write (log_file,'(a,a)')' --> ', trim(fname_tmp) - inquire(file=trim(fname_tmp), exist=file_exists) + tmpstring = 'Step 04: Vegetation types using ESA land cover (CatchCNCLM40)' + fname_tmp = 'clsm/CLM_veg_typs_fracs' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + inquire(file=trim(fname_tmp), exist=file_exists) if (.not.file_exists) then - write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' - + write (log_file,'(a)')' Creating file...' call system_clock(clock1) - if (trim(LAIBCS) == 'GSWP2') then - call process_gswp2_veg (nc,nr,regrid,'grnFrac',n_land, tile_id) - else - if (size(maparc30%ij_index,1) /= 43200) then - ! allocate (maparc30 (1:43200,1:21600)) - call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) - endif - call hres_gswp2 (43200,21600, maparc30, 'green', n_land, tile_lon, tile_lat) - endif + call ESA2CLM (nc,nr, n_land, tile_lat, tile_pfs, tile_id) call system_clock(clock2) seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" + write (log_file, *) ' Done. Spent ', seconds, " seconds" else write (log_file,'(a)')' Using existing file.' endif + write (log_file,'(a)')' ' - fname_tmp = 'clsm/lai.dat' - write (log_file,'(a,a)')' --> ', trim(fname_tmp) + else + + tmpstring = 'Step 03: Vegetation types using IGBP SiB2 land cover (MOSAIC/Catch)' + fname_tmp = 'clsm/mosaic_veg_typs_fracs' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' inquire(file=trim(fname_tmp), exist=file_exists) if (.not.file_exists) then - write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' - redo_modis = .true. - + write (log_file,'(a)')' Creating file...' call system_clock(clock1) - if (trim(LAIBCS) == 'GSWP2') call process_gswp2_veg (nc,nr,regrid,'LAI', n_land, tile_id) - if (trim(LAIBCS) == 'GSWPH') then - if (size(maparc30%ij_index,1) /= 43200) then - ! allocate (maparc30 (1:43200,1:21600)) - call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) - endif - inquire(file='clsm/lai.MODIS_8-DayClim', exist=file_exists) - if (.not.file_exists) call hres_gswp2 (43200,21600, maparc30, 'lai', n_land, tile_lon, tile_lat) - endif - - if (trim(LAIBCS) == 'MODIS') then - lai_name = 'MODIS_8-DayClim/MODIS_' - call hres_lai_no_gswp (43200,21600,maparc30,lai_name, n_land, tile_lon, tile_lon) - endif - - if (trim(LAIBCS) == 'MODGEO') then - lai_name = 'MODIS_8-DayClim/MODIS_' - inquire(file='clsm/lai.MODIS_8-DayClim', exist=file_exists) - if (.not.file_exists)call hres_lai_no_gswp (43200,21600,maparc30,lai_name, n_land, tile_lon, tile_lat, merge=1) - call merge_lai_data (MaskFile, n_land, tile_pfs) - endif - - if (trim(LAIBCS) == 'MODISV6') then - lai_name = 'MCD15A2H.006/MODIS_' - call grid2tile_modis6 (86400,43200,nc,nr,n_land, tile_lon, tile_lat, tile_id, lai_name) - endif - - if (trim(LAIBCS) == 'GLASSA') then - lai_name = 'GLASS-LAI/AVHRR.v4/GLASS01B02.V04.AYYYY' - call grid2tile_glass (nc,nr, tile_id,lai_name, n_land, tile_lon, tile_lat) - endif - - if (trim(LAIBCS) == 'GLASSM') then - lai_name = 'GLASS-LAI/MODIS.v4/GLASS01B01.V04.AYYYY' - call grid2tile_glass (nc,nr,tile_id,lai_name, n_land, tile_lon, tile_lat) - endif + call compute_mosaic_veg_types (nc, nr, regrid, n_land, tile_pfs, tile_id) call system_clock(clock2) seconds = (clock2-clock1)/real(clock_rate) write (log_file, *) ' Done. Spent ', seconds, " seconds" else write (log_file,'(a)')' Using existing file.' endif + write (log_file,'(a)')' ' + + ! Per make_bcs, it looks like there are four possible mask files: + ! + ! GEOS5_10arcsec_mask.nc + ! global.cat_id.catch.DL + ! global.cat_id.catch.GreatLakesCaspian_Updated.DL + ! GEOS5_10arcsec_mask_freshwater-lakes.nc + ! + ! If we are in this else block, we must be using one of the latter three masks. + ! It looks like these latter masks only work for Catchment and not CatchCNCLM[xx] + ! + ! - reichle, 11 Jan 2022 + + write (log_file,'(a)')'NOTE: The selected mask works only for the Catchment model.' + write (log_file,'(a)')' Vegetation types *not* created for CatchCNCLM[xx].' + write (log_file,'(a)')' SKIPPING Step 04 and Step 05 !!!' + write (log_file,'(a)')' ' + + endif + + ! Processing Vegetation Climatology + ! --------------------------------- + + ! creating mapping arrays if necessary + + tmpstring = 'Step 05: Vegetation climatologies' + write (log_file,'(a,a,a)') trim(tmpstring),' ', trim(LAIBCS) - fname_tmp = 'clsm/ndvi.dat' + if((trim(LAIBCS) == 'MODGEO').or.(trim(LAIBCS) == 'GEOLAND2')) then + fname_tmp = 'clsm/lai.GEOLAND2_10-DayClim' write (log_file,'(a,a)')' --> ', trim(fname_tmp) - inquire(file=trim(fname_tmp), exist=file_exists) + inquire(file=trim(fname_tmp), exist=file_exists) if (.not.file_exists) then - write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' + write (log_file,'(a)')' Creating file...' + !allocate (mapgeoland2 (1:40320,1:20160)) call system_clock(clock1) - call gimms_clim_ndvi (nc,nr, n_land, tile_id) + call create_mapping (nc,nr,40320,20160,mapgeoland2, n_land, tile_id ) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done create mapping mapgeoland2. Spent ', seconds, " seconds" + lai_name = 'GEOLAND2_10-DayClim/geoland2_' + + write (log_file,'(a)')' Creating '//lai_name + call system_clock(clock1) + if(trim(LAIBCS) == 'GEOLAND2') then + call hres_lai_no_gswp (40320,20160,mapgeoland2, lai_name, n_land, tile_lon, tile_lat) + else + call hres_lai_no_gswp (40320,20160,mapgeoland2, lai_name, n_land, tile_lon, tile_lat, merge=1) + endif call system_clock(clock2) seconds = (clock2-clock1)/real(clock_rate) write (log_file, *) ' Done. Spent ', seconds, " seconds" + ! if(allocated(mapgeoland2)) deallocate (mapgeoland2) + deallocate (mapgeoland2%map) + deallocate (mapgeoland2%ij_index) + write (log_file,'(a)')' Done.' else write (log_file,'(a)')' Using existing file.' endif + endif - write (log_file,'(a)')' ' - - ! ------------------------------------------------- - - ! call modis_alb_on_tiles (nc,nr,ease_grid,regrid,fnameTil,fnameRst) - ! call modis_scale_para (ease_grid,fnameTil) - ! NOTE: modis_alb_on_tiles uses monthly climatological raster data on 8640x4320 to produce - ! MODIS albedo on tile space. The subroutine was replaced with "modis_alb_on_tiles_high" that process - ! MODIS1 data on native grid and produces 8/16-day MODIS Albedo climatology - - - tmpstring = 'Step 06: Albedo climatologies' - write (log_file,'(a,a,a)') trim(tmpstring),' ', trim(MODALB) - - if(MODALB == 'MODIS1') then - fname_tmp = 'clsm/AlbMap.WS.16-day.tile.0.7_5.0.dat' - write (log_file,'(a,a)')' --> ', trim(fname_tmp) - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - if(F25Tag) then - call create_mapping (nc,nr,21600,10800,maparc60, n_land, tile_id) - call modis_alb_on_tiles_high (21600,10800,maparc60,MODALB, n_land) - deallocate (maparc60%map) - deallocate (maparc60%ij_index) - else - ! This option is for legacy sets like Fortuna 2.1 - call modis_alb_on_tiles (nc,nr,regrid, n_land, tile_id) - endif - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')' Using existing file.' + if ((LAIBCS == 'MODGEO').or.(LAIBCS == 'MODIS').or.(MODALB == 'MODIS2')) then + ! allocate (maparc30 (1:43200,1:21600)) + call system_clock(clock1) + call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done create mapping maparc30. Spent ', seconds, " seconds" + endif + + fname_tmp = 'clsm/green.dat' + write (log_file,'(a,a)')' --> ', trim(fname_tmp) + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' + + call system_clock(clock1) + if (trim(LAIBCS) == 'GSWP2') then + call process_gswp2_veg (nc,nr,regrid,'grnFrac',n_land, tile_id) + else + if (size(maparc30%ij_index,1) /= 43200) then + ! allocate (maparc30 (1:43200,1:21600)) + call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) endif + call hres_gswp2 (43200,21600, maparc30, 'green', n_land, tile_lon, tile_lat) endif - - if(MODALB == 'MODIS2') then - fname_tmp = 'clsm/AlbMap.WS.8-day.tile.0.3_0.7.dat' - fname_tmp2 = 'clsm/AlbMap.WS.8-day.tile.0.7_5.0.dat' - write (log_file,'(a,a,a,a)')' --> ', trim(fname_tmp), ', ', trim(fname_tmp2) - inquire(file=trim(fname_tmp ), exist=file_exists ) - inquire(file=trim(fname_tmp2), exist=file_exists2) - if ((.not.file_exists).or.(.not.file_exists2)) then - call system_clock(clock1) - write (log_file,'(a)')' Creating files...' - call modis_alb_on_tiles_high (43200,21600,maparc30,MODALB, n_land) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')' Using existing file.' + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' + endif + + fname_tmp = 'clsm/lai.dat' + write (log_file,'(a,a)')' --> ', trim(fname_tmp) + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' + redo_modis = .true. + + call system_clock(clock1) + if (trim(LAIBCS) == 'GSWP2') call process_gswp2_veg (nc,nr,regrid,'LAI', n_land, tile_id) + if (trim(LAIBCS) == 'GSWPH') then + if (size(maparc30%ij_index,1) /= 43200) then + ! allocate (maparc30 (1:43200,1:21600)) + call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) endif + inquire(file='clsm/lai.MODIS_8-DayClim', exist=file_exists) + if (.not.file_exists) call hres_gswp2 (43200,21600, maparc30, 'lai', n_land, tile_lon, tile_lat) endif - write (log_file,'(a)')' ' - - ! --------------------------------------------- - - tmpstring = 'Step 07: Albedo scale factors' - write (log_file,'(a,a,a)') trim(tmpstring),' ', trim(MODALB) - - ! NOTE: There are two files with albedo scale factors: "visdf.dat" and "nirdf.dat". - ! Added check for "nirdf.dat", which was missing before. - reichle, 13 Jan 2022 - fname_tmp = 'clsm/visdf.dat' - fname_tmp2 = 'clsm/nirdf.dat' - write (log_file,'(a,a,a,a)')' --> ', trim(fname_tmp), ', ', trim(fname_tmp2) - inquire(file=trim(fname_tmp ), exist=file_exists ) - inquire(file=trim(fname_tmp2), exist=file_exists2) - if ((redo_modis).or.(.not.file_exists).or.(.not.file_exists2)) then - ! if(.not.F25Tag) then - write (log_file,'(a)')' Creating files... (resolution will be added to file name later)' - call system_clock(clock1) - call modis_scale_para_high (MODALB, n_land) - ! else - ! This option is for legacy sets like Fortuna 2.1 - ! inquire(file='clsm/modis_scale_factor.albvf.clim', exist=file_exists) - ! if ((redo_modis).or.(.not.file_exists)) then - ! call modis_scale_para (ease_grid,fnameTil) - ! call REFORMAT_VEGFILES - ! endif - ! endif - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')' Using existing files.' + if (trim(LAIBCS) == 'MODIS') then + lai_name = 'MODIS_8-DayClim/MODIS_' + call hres_lai_no_gswp (43200,21600,maparc30,lai_name, n_land, tile_lon, tile_lon) endif - write (log_file,'(a)')' ' - - ! tmpstring1 = '-e EASE -g '//trim(gfile) - ! write(tmpstring2,'(2(a2,x,i5,x))')'-x',nc,'-y',nr - ! tmpstring = 'bin/mkCatchParam_openmp '//trim(tmpstring2)//' '//trim(tmpstring1) - -! else - - ! this block is for n_threads>1 - !============================== - - if(trim(SOILBCS)=='NGDC') then - write (log_file,'(a)')'Creating (intermediate) NGDC soil types file...' - call system_clock(clock1) - call create_soil_types_files (nc,nr, n_land, tile_pfs, tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - write (log_file,'(a)')' ' + + if (trim(LAIBCS) == 'MODGEO') then + lai_name = 'MODIS_8-DayClim/MODIS_' + inquire(file='clsm/lai.MODIS_8-DayClim', exist=file_exists) + if (.not.file_exists)call hres_lai_no_gswp (43200,21600,maparc30,lai_name, n_land, tile_lon, tile_lat, merge=1) + call merge_lai_data (MaskFile, n_land, tile_pfs) endif - - ! Creating soil_param.first and tau_param.dat files that has 2 options: - ! 1) NGDC soil properties, 2) HWSD-STATSGO2 Soil Properties - ! --------------------------------------------------------------------- - - tmpstring = 'Step 08: Soil parameters ' // trim(SOILBCS) - fname_tmp = 'clsm/soil_param.first' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - if(trim(SOILBCS)=='NGDC') then - if( F25Tag) call soil_para_high (nc,nr,regrid, n_land, tile_id,F25Tag=F25Tag) - if(.not.F25Tag) call soil_para_high (nc,nr,regrid, n_land, tile_id) - endif - if(SOILBCS(1:4)=='HWSD') call soil_para_hwsd (nc,nr, n_land, tile_pfs, tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a,a)')' Using existing file.' + + if (trim(LAIBCS) == 'MODISV6') then + lai_name = 'MCD15A2H.006/MODIS_' + call grid2tile_modis6 (86400,43200,nc,nr,n_land, tile_lon, tile_lat, tile_id, lai_name) endif - write (log_file,'(a)')' ' - - tmpstring = 'Step 09: CLSM model parameters ' // trim(SOILBCS) - fname_tmp = 'clsm/ar.new' - fname_tmp2 = 'clsm/bf.dat' - fname_tmp3 = 'clsm/ts.dat' - fname_tmp4 = 'clsm/soil_param.dat' - tmpstring1 = trim(fname_tmp) // ', ' // trim(fname_tmp2) // ', ' // trim(fname_tmp3) // ', ' // trim(fname_tmp4) - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(tmpstring1), ')' - inquire(file=trim(fname_tmp ), exist=file_exists ) - inquire(file=trim(fname_tmp2), exist=file_exists2) - inquire(file=trim(fname_tmp3), exist=file_exists3) - inquire(file=trim(fname_tmp4), exist=file_exists4) - if ((.not.file_exists).or.(.not.file_exists2).or.(.not.file_exists3).or.(.not.file_exists4)) then - write (log_file,'(a)')' Creating files...' - call system_clock(clock1) - if(trim(SOILBCS)=='NGDC') call create_model_para( MaskFile, n_land, tile_lon, tile_lat, tile_pfs) - if(SOILBCS(1:4) =='HWSD') call create_model_para_woesten(MaskFile, n_land, tile_lon, tile_lat, tile_pfs) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) ' Done. Spent ', seconds, " seconds" - else - write (log_file,'(a,a)')' Using existing files.' + + if (trim(LAIBCS) == 'GLASSA') then + lai_name = 'GLASS-LAI/AVHRR.v4/GLASS01B02.V04.AYYYY' + call grid2tile_glass (nc,nr, tile_id,lai_name, n_land, tile_lon, tile_lat) endif - write (log_file,'(a)')' ' - - ! Commented out this call because 7.5-minute raster file is only used - ! for plotting purposes - ! call make_75 (nc,nr,regrid,c_data,fnameRst) - ! write (log_file,'(a)')'Done creating 7.5 minute raster file ......................' - write (log_file,'(a)')'NOTE: 7.5 minute raster file not created (only needed for diagnostic plotting).' - write (log_file,'(a)')' Uncomment associated lines in source to generate 7.5 minute raster file.' - write (log_file,'(a)')' ' - - tmpstring = 'Step 10: CatchCNCLM40 NDep T2m SoilAlb parameters' - fname_tmp = 'clsm/CLM_NDep_SoilAlb_T2m' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - ! create this file only if matching veg types file already exists - inquire(file='clsm/CLM_veg_typs_fracs', exist=file_exists) - if (file_exists) then - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - call grid2tile_ndep_t2m_alb (nc,nr, n_land,tile_id) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) 'Done. Spent ', seconds, " seconds" - else - write (log_file,'(a)')'Skipping step for lack of matching veg types file.' + + if (trim(LAIBCS) == 'GLASSM') then + lai_name = 'GLASS-LAI/MODIS.v4/GLASS01B01.V04.AYYYY' + call grid2tile_glass (nc,nr,tile_id,lai_name, n_land, tile_lon, tile_lat) endif - write (log_file,'(a)')' ' - - tmpstring = 'Step 11: CatchCNCLM45 abm peatf gdp hdm fc parameters' - fname_tmp = 'clsm/CLM4.5_abm_peatf_gdp_hdm_fc' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - inquire(file=trim(fname_tmp), exist=file_exists) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' + endif + + fname_tmp = 'clsm/ndvi.dat' + write (log_file,'(a,a)')' --> ', trim(fname_tmp) + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' + call system_clock(clock1) + call gimms_clim_ndvi (nc,nr, n_land, tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' + endif + + write (log_file,'(a)')' ' + + ! ------------------------------------------------- + + ! call modis_alb_on_tiles (nc,nr,ease_grid,regrid,fnameTil,fnameRst) + ! call modis_scale_para (ease_grid,fnameTil) + ! NOTE: modis_alb_on_tiles uses monthly climatological raster data on 8640x4320 to produce + ! MODIS albedo on tile space. The subroutine was replaced with "modis_alb_on_tiles_high" that process + ! MODIS1 data on native grid and produces 8/16-day MODIS Albedo climatology + + + tmpstring = 'Step 06: Albedo climatologies' + write (log_file,'(a,a,a)') trim(tmpstring),' ', trim(MODALB) + + if(MODALB == 'MODIS1') then + fname_tmp = 'clsm/AlbMap.WS.16-day.tile.0.7_5.0.dat' + write (log_file,'(a,a)')' --> ', trim(fname_tmp) + inquire(file=trim(fname_tmp), exist=file_exists) if (.not.file_exists) then write (log_file,'(a)')' Creating file...' call system_clock(clock1) - call CLM45_fixed_parameters (nc,nr, n_land, tile_id) + if(F25Tag) then + call create_mapping (nc,nr,21600,10800,maparc60, n_land, tile_id) + call modis_alb_on_tiles_high (21600,10800,maparc60,MODALB, n_land) + deallocate (maparc60%map) + deallocate (maparc60%ij_index) + else + ! This option is for legacy sets like Fortuna 2.1 + call modis_alb_on_tiles (nc,nr,regrid, n_land, tile_id) + endif call system_clock(clock2) seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) 'Done. Spent ', seconds, " seconds" + write (log_file, *) ' Done. Spent ', seconds, " seconds" else write (log_file,'(a)')' Using existing file.' endif - write (log_file,'(a)')' ' - - tmpstring = 'Step 12: CatchCNCLM45 lightning frequency' - fname_tmp = 'clsm/lnfm.dat' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' + endif + + if(MODALB == 'MODIS2') then + fname_tmp = 'clsm/AlbMap.WS.8-day.tile.0.3_0.7.dat' + fname_tmp2 = 'clsm/AlbMap.WS.8-day.tile.0.7_5.0.dat' + write (log_file,'(a,a,a,a)')' --> ', trim(fname_tmp), ', ', trim(fname_tmp2) + inquire(file=trim(fname_tmp ), exist=file_exists ) + inquire(file=trim(fname_tmp2), exist=file_exists2) + if ((.not.file_exists).or.(.not.file_exists2)) then call system_clock(clock1) - call CLM45_clim_parameters (nc,nr,n_land,tile_id) + write (log_file,'(a)')' Creating files...' + call modis_alb_on_tiles_high (43200,21600,maparc30,MODALB, n_land) call system_clock(clock2) seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) 'Done. Spent ', seconds, " seconds" + write (log_file, *) ' Done. Spent ', seconds, " seconds" else write (log_file,'(a)')' Using existing file.' endif + endif + write (log_file,'(a)')' ' + + ! --------------------------------------------- + + tmpstring = 'Step 07: Albedo scale factors' + write (log_file,'(a,a,a)') trim(tmpstring),' ', trim(MODALB) + + ! NOTE: There are two files with albedo scale factors: "visdf.dat" and "nirdf.dat". + ! Added check for "nirdf.dat", which was missing before. - reichle, 13 Jan 2022 + + fname_tmp = 'clsm/visdf.dat' + fname_tmp2 = 'clsm/nirdf.dat' + write (log_file,'(a,a,a,a)')' --> ', trim(fname_tmp), ', ', trim(fname_tmp2) + inquire(file=trim(fname_tmp ), exist=file_exists ) + inquire(file=trim(fname_tmp2), exist=file_exists2) + if ((redo_modis).or.(.not.file_exists).or.(.not.file_exists2)) then + ! if(.not.F25Tag) then + write (log_file,'(a)')' Creating files... (resolution will be added to file name later)' + call system_clock(clock1) + call modis_scale_para_high (MODALB, n_land) + ! else + ! This option is for legacy sets like Fortuna 2.1 + ! inquire(file='clsm/modis_scale_factor.albvf.clim', exist=file_exists) + ! if ((redo_modis).or.(.not.file_exists)) then + ! call modis_scale_para (ease_grid,fnameTil) + ! call REFORMAT_VEGFILES + ! endif + ! endif + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing files.' + endif + write (log_file,'(a)')' ' + + ! tmpstring1 = '-e EASE -g '//trim(gfile) + ! write(tmpstring2,'(2(a2,x,i5,x))')'-x',nc,'-y',nr + ! tmpstring = 'bin/mkCatchParam_openmp '//trim(tmpstring2)//' '//trim(tmpstring1) + + ! else + + ! this block is for n_threads>1 + !============================== + + if(trim(SOILBCS)=='NGDC') then + write (log_file,'(a)')'Creating (intermediate) NGDC soil types file...' + call system_clock(clock1) + call create_soil_types_files (nc,nr, n_land, tile_pfs, tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" write (log_file,'(a)')' ' + endif - tmpstring = 'Step 13: Country and state codes' - fname_tmp = 'clsm/country_and_state_code.data' - write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' - inquire(file=trim(fname_tmp), exist=file_exists) - if (.not.file_exists) then - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - call map_country_codes (nc,nr,n_land, tile_lon, tile_lat) - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) 'Done. Spent ', seconds, " seconds" + ! Creating soil_param.first and tau_param.dat files that has 2 options: + ! 1) NGDC soil properties, 2) HWSD-STATSGO2 Soil Properties + ! --------------------------------------------------------------------- + + tmpstring = 'Step 08: Soil parameters ' // trim(SOILBCS) + fname_tmp = 'clsm/soil_param.first' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file...' + call system_clock(clock1) + if(trim(SOILBCS)=='NGDC') then + if( F25Tag) call soil_para_high (nc,nr,regrid, n_land, tile_id,F25Tag=F25Tag) + if(.not.F25Tag) call soil_para_high (nc,nr,regrid, n_land, tile_id) + endif + if(SOILBCS(1:4)=='HWSD') call soil_para_hwsd (nc,nr, n_land, tile_pfs, tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a,a)')' Using existing file.' + endif + write (log_file,'(a)')' ' + + tmpstring = 'Step 09: CLSM model parameters ' // trim(SOILBCS) + fname_tmp = 'clsm/ar.new' + fname_tmp2 = 'clsm/bf.dat' + fname_tmp3 = 'clsm/ts.dat' + fname_tmp4 = 'clsm/soil_param.dat' + tmpstring1 = trim(fname_tmp) // ', ' // trim(fname_tmp2) // ', ' // trim(fname_tmp3) // ', ' // trim(fname_tmp4) + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(tmpstring1), ')' + inquire(file=trim(fname_tmp ), exist=file_exists ) + inquire(file=trim(fname_tmp2), exist=file_exists2) + inquire(file=trim(fname_tmp3), exist=file_exists3) + inquire(file=trim(fname_tmp4), exist=file_exists4) + if ((.not.file_exists).or.(.not.file_exists2).or.(.not.file_exists3).or.(.not.file_exists4)) then + write (log_file,'(a)')' Creating files...' + call system_clock(clock1) + if(trim(SOILBCS)=='NGDC') call create_model_para( MaskFile, n_land, tile_lon, tile_lat, tile_pfs) + if(SOILBCS(1:4) =='HWSD') call create_model_para_woesten(MaskFile, n_land, tile_lon, tile_lat, tile_pfs) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) ' Done. Spent ', seconds, " seconds" + else + write (log_file,'(a,a)')' Using existing files.' + endif + write (log_file,'(a)')' ' + + ! Commented out this call because 7.5-minute raster file is only used + ! for plotting purposes + ! call make_75 (nc,nr,regrid,c_data,fnameRst) + ! write (log_file,'(a)')'Done creating 7.5 minute raster file ......................' + write (log_file,'(a)')'NOTE: 7.5 minute raster file not created (only needed for diagnostic plotting).' + write (log_file,'(a)')' Uncomment associated lines in source to generate 7.5 minute raster file.' + write (log_file,'(a)')' ' + + tmpstring = 'Step 10: CatchCNCLM40 NDep T2m SoilAlb parameters' + fname_tmp = 'clsm/CLM_NDep_SoilAlb_T2m' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + ! create this file only if matching veg types file already exists + inquire(file='clsm/CLM_veg_typs_fracs', exist=file_exists) + if (file_exists) then + write (log_file,'(a)')' Creating file...' + call system_clock(clock1) + call grid2tile_ndep_t2m_alb (nc,nr, n_land,tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) 'Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')'Skipping step for lack of matching veg types file.' + endif + write (log_file,'(a)')' ' + + tmpstring = 'Step 11: CatchCNCLM45 abm peatf gdp hdm fc parameters' + fname_tmp = 'clsm/CLM4.5_abm_peatf_gdp_hdm_fc' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file...' + call system_clock(clock1) + call CLM45_fixed_parameters (nc,nr, n_land, tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) 'Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' + endif + write (log_file,'(a)')' ' + + tmpstring = 'Step 12: CatchCNCLM45 lightning frequency' + fname_tmp = 'clsm/lnfm.dat' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file... (resolution will be added to file name later)' + call system_clock(clock1) + call CLM45_clim_parameters (nc,nr,n_land,tile_id) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) 'Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' + endif + write (log_file,'(a)')' ' + + tmpstring = 'Step 13: Country and state codes' + fname_tmp = 'clsm/country_and_state_code.data' + write (log_file,'(a,a,a,a)') trim(tmpstring), ' (', trim(fname_tmp), ')' + inquire(file=trim(fname_tmp), exist=file_exists) + if (.not.file_exists) then + write (log_file,'(a)')' Creating file...' + call system_clock(clock1) + call map_country_codes (nc,nr,n_land, tile_lon, tile_lat) + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) 'Done. Spent ', seconds, " seconds" + else + write (log_file,'(a)')' Using existing file.' + endif + write (log_file,'(a)')' ' + + if(process_snow_albedo)then + tmpstring = 'Step 14: Static snow albedo from MODIS' + write (log_file,'(a)') trim(tmpstring) + write (log_file,'(a)')' Creating file...' + call system_clock(clock1) + if (trim(SNOWALB)=='MODC061') then + call MODIS_snow_alb (n_land, min_lon, max_lon, min_lat, max_lat) + elseif (trim(SNOWALB)=='MODC061v2') then + if (size(maparc30%ij_index,1) /= 43200) then + call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) + end if + call MODIS_snow_alb_v2(43200,21600,maparc30, n_land) else - write (log_file,'(a)')' Using existing file.' + write (log_file,'(a)')'Unknown SNOWALB... stopping!' + stop endif + call system_clock(clock2) + seconds = (clock2-clock1)/real(clock_rate) + write (log_file, *) 'Done. Spent ', seconds, " seconds" write (log_file,'(a)')' ' + endif - if(process_snow_albedo)then - tmpstring = 'Step 14: Static snow albedo from MODIS' - write (log_file,'(a)') trim(tmpstring) - write (log_file,'(a)')' Creating file...' - call system_clock(clock1) - if (trim(SNOWALB)=='MODC061') then - call MODIS_snow_alb (n_land, min_lon, max_lon, min_lat, max_lat) - elseif (trim(SNOWALB)=='MODC061v2') then - if (size(maparc30%ij_index,1) /= 43200) then - call create_mapping (nc,nr,43200,21600,maparc30, n_land, tile_id) - end if - call MODIS_snow_alb_v2(43200,21600,maparc30, n_land) - else - write (log_file,'(a)')'Unknown SNOWALB... stopping!' - stop - endif - call system_clock(clock2) - seconds = (clock2-clock1)/real(clock_rate) - write (log_file, *) 'Done. Spent ', seconds, " seconds" - write (log_file,'(a)')' ' - endif - - if(IRRIGBCS) then + if(IRRIGBCS) then tmpstring = 'Step 15: Irrigation' inquire(file='clsm/irrig.dat', exist=file_exists) if (.not.file_exists) then @@ -803,16 +803,15 @@ PROGRAM mkCatchParam call create_irrig_params (nc,nr,fnameRst) write (log_file,'(a)') ' Done computing irrigation model parameters........' endif + endif - endif - - write (log_file,'(a)')'============================================================' - write (log_file,'(a)')'DONE creating CLSM data files...............................' - write (log_file,'(a)')'============================================================' - write (log_file,'(a)')' ' - - ! call execute_command_line ('chmod 755 bin/create_README.csh ; bin/create_README.csh') -! endif + write (log_file,'(a)')'============================================================' + write (log_file,'(a)')'DONE creating CLSM data files...............................' + write (log_file,'(a)')'============================================================' + write (log_file,'(a)')' ' + + ! call execute_command_line ('chmod 755 bin/create_README.csh ; bin/create_README.csh') + ! endif close (log_file,status='keep') From 019cfbf2b8e7b157bf958055200fb08aed0ef121 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 29 Jul 2025 15:07:58 -0400 Subject: [PATCH 38/55] export IRRG_RATE_TOT from IrrigationGC instead of Catch[CN]GC --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 10 +++----- .../GEOS_CatchCNGridComp.F90 | 2 -- .../GEOS_CatchCNCLM40GridComp.F90 | 14 ----------- .../GEOS_CatchCNCLM45GridComp.F90 | 14 ----------- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 14 ----------- .../GEOS_IrrigationGridComp.F90 | 25 ++++++++++++++++--- 6 files changed, 24 insertions(+), 55 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 8b1ec5192..25678d19e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -555,11 +555,6 @@ subroutine SetServices ( GC, RC ) CHILD_ID = CATCH(1), & RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, & - SHORT_NAME = 'IRRG_RATE_TOT', & - CHILD_ID = CATCH(1), & - RC=STATUS ) - VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, & SHORT_NAME = 'SNOLAND', & CHILD_ID = CATCH(1), & @@ -1122,8 +1117,6 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'PRLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_TOT', CHILD_ID = CATCHCN(1), RC=STATUS ) - VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SNOLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRPARLAND' , CHILD_ID = CATCHCN(1), RC=STATUS ) @@ -1382,12 +1375,15 @@ subroutine SetServices ( GC, RC ) endif END SELECT ! LSM_CHOICE (Catch, CatchCN) + + ! ------------------------------------------------------------------------------------------------------------------- if (RUN_IRRIG /= 0) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_SPR', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_PDY', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_FRW', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_DRP', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_TOT', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 3573f7f85..f809570d2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -826,8 +826,6 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'PRLAND' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_TOT' , CHILD_ID = CATCHCN, RC=STATUS ) - VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SNOLAND' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DRPARLAND' , CHILD_ID = CATCHCN, RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 8ffa7a183..195c4eb60 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -2878,15 +2878,6 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'IRRG_RATE_TOT', & - LONG_NAME = 'irrigation_flux_total', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsTileOnly, & - VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SNOLAND', & LONG_NAME = 'snowfall_land', & @@ -4716,7 +4707,6 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND - real, dimension(:), pointer :: IRRG_RATE_TOT real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -5357,7 +5347,6 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP, 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND, 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND, 'PRLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IRRG_RATE_TOT,'IRRG_RATE_TOT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND, 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND, 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND, 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -7405,9 +7394,6 @@ subroutine Driver ( RC ) if(associated( WCPR )) WCPR = PRMC if(associated( ACCUM)) ACCUM = SLDTOT - EVPICE*(1./MAPL_ALHS) - SMELT if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT - if(associated(IRRG_RATE_TOT)) then - if (catchcn_internal%RUN_IRRIG /= 0) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW + IRRG_RATE_PDY + IRRG_RATE_DRP - endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(EVPSNO)) EVPSNO = EVPICE if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 15b2daf2e..e786749a8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -2813,15 +2813,6 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'IRRG_RATE_TOT', & - LONG_NAME = 'irrigation_flux_total', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsTileOnly, & - VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SNOLAND', & LONG_NAME = 'snowfall_land', & @@ -4698,7 +4689,6 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND - real, dimension(:), pointer :: IRRG_RATE_TOT real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -5395,7 +5385,6 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP , 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND , 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND , 'PRLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IRRG_RATE_TOT , 'IRRG_RATE_TOT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND , 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND , 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND , 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -7689,9 +7678,6 @@ subroutine Driver ( RC ) if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT - if(associated(IRRG_RATE_TOT)) then - if(catchcn_internal%RUN_IRRIG /= 0) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW + IRRG_RATE_PDY + IRRG_RATE_DRP - endif if(associated(SNOLAND)) SNOLAND = SLDTOT if(associated(DRPARLAND)) DRPARLAND = DRPAR if(associated(DFPARLAND)) DFPARLAND = DFPAR diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 33c30e413..9dcf9ccdc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -2375,15 +2375,6 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'IRRG_RATE_TOT', & - LONG_NAME = 'irrigation_flux_total', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsTileOnly, & - VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SNOLAND', & LONG_NAME = 'snowfall_land', & @@ -4048,7 +4039,6 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: EVLAND real, dimension(:), pointer :: PRLAND - real, dimension(:), pointer :: IRRG_RATE_TOT real, dimension(:), pointer :: SNOLAND real, dimension(:), pointer :: DRPARLAND real, dimension(:), pointer :: DFPARLAND @@ -4615,7 +4605,6 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SNOWDP, 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVLAND, 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PRLAND, 'PRLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IRRG_RATE_TOT,'IRRG_RATE_TOT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SNOLAND, 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DRPARLAND, 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,DFPARLAND, 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) @@ -5923,9 +5912,6 @@ subroutine Driver ( RC ) if(associated(EVPSNO)) EVPSNO = EVPICE if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT - if(associated(IRRG_RATE_TOT)) then - if (CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW +IRRG_RATE_PDY + IRRG_RATE_DRP - endif if(associated(SNOLAND)) SNOLAND = SLDTOT ! note, not just SNO if(associated(DRPARLAND)) DRPARLAND = DRPAR if(associated(DFPARLAND)) DFPARLAND = DFPAR diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index b49bcdbab..5c3ee63d9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -29,7 +29,7 @@ module GEOS_IrrigationGridCompMod ! ! IMPORTS: POROS, WPWET, VGWMAX, WCRZ, LAI\\ ! -! EXPORTS: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY\\ +! EXPORTS: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, IRRG_RATE_TOT\\ ! ! INTERNALS: IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_CROPIRRIGFRAC, IRRG_DOY_PLANT, IRRG_DOY_HARVEST, ! IRRG_TYPE, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, IRRG_LAIMIN, IRRG_LAIMAX\\ @@ -398,6 +398,15 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + SHORT_NAME = 'IRRG_RATE_TOT' ,& + LONG_NAME = 'irrigation_flux_total' ,& + UNITS = 'kg m-2 s-1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) ! ----------------------------------------------------------- ! Import states @@ -516,12 +525,13 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) real, dimension(:,:), pointer :: DRATE real, dimension(:,:), pointer :: FRATE -! EXPORT ponters +! EXPORT pointers real, dimension(:), pointer :: IRRG_RATE_SPR real, dimension(:), pointer :: IRRG_RATE_DRP real, dimension(:), pointer :: IRRG_RATE_FRW real, dimension(:), pointer :: IRRG_RATE_PDY + real, dimension(:), pointer :: IRRG_RATE_TOT type(irrigation_model), pointer :: IM type (IRRIG_wrap) :: wrap @@ -570,6 +580,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP, 'IRRG_RATE_DRP', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW, 'IRRG_RATE_FRW', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY, 'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_TOT, 'IRRG_RATE_TOT', RC=STATUS) ; VERIFY_(STATUS) ! Update IRRG_IRRIGFRAC and IRRG_PADDYFRAC for applications that are run on regular tiles in ! which IRRG_IRRIGFRAC and IRRG_PADDYFRAC in BCs are fractions. @@ -618,6 +629,8 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) IRRG_RATE_FRW = IRRG_RATE_FRW * IRRG_IRRIGFRAC IRRG_RATE_PDY = IRRG_RATE_PDY * IRRG_PADDYFRAC + if(associated(IRRG_RATE_TOT)) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW +IRRG_RATE_PDY + IRRG_RATE_DRP + call MAPL_TimerOff(MAPL,"INITIALIZE") RETURN_(ESMF_SUCCESS) @@ -666,12 +679,13 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) real, dimension(:,:), pointer :: DRATE real, dimension(:,:), pointer :: FRATE -! EXPORT ponters +! EXPORT pointers real, dimension(:), pointer :: IRRG_RATE_SPR real, dimension(:), pointer :: IRRG_RATE_DRP real, dimension(:), pointer :: IRRG_RATE_FRW real, dimension(:), pointer :: IRRG_RATE_PDY + real, dimension(:), pointer :: IRRG_RATE_TOT ! IMPORT pointers @@ -747,6 +761,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP ,'IRRG_RATE_DRP', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY ,'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW ,'IRRG_RATE_FRW', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_TOT ,'IRRG_RATE_TOT', RC=STATUS) ; VERIFY_(STATUS) @@ -859,7 +874,9 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) IRRG_RATE_DRP = IRRG_RATE_DRP * IRRG_IRRIGFRAC IRRG_RATE_FRW = IRRG_RATE_FRW * IRRG_IRRIGFRAC IRRG_RATE_PDY = IRRG_RATE_PDY * IRRG_PADDYFRAC - + + if(associated(IRRG_RATE_TOT)) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW +IRRG_RATE_PDY + IRRG_RATE_DRP + deallocate (local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF, IM) call MAPL_TimerOff(MAPL,"RUN") From 166073d059fc1ba48753e628f58d812955604aae Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 29 Jul 2025 17:08:28 -0400 Subject: [PATCH 39/55] use consistent order of IRRG_RATE_* terms: SPR, DRP, FRW, PDY --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 4 +- .../GEOS_CatchCNCLM40GridComp.F90 | 8 +-- .../GEOS_IrrigationGridComp.F90 | 17 +++-- .../irrigation_model.F90 | 70 ++++++++++--------- 4 files changed, 54 insertions(+), 45 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 25678d19e..e60f9cafe 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -1380,9 +1380,9 @@ subroutine SetServices ( GC, RC ) if (RUN_IRRIG /= 0) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_SPR', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_PDY', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) - call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_FRW', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_DRP', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_FRW', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_PDY', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'IRRG_RATE_TOT', CHILD_ID = IRRIGATION(1),RC=STATUS ) ; VERIFY_(STATUS) end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 195c4eb60..c9f538618 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -5177,8 +5177,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,IRRG_RATE_SPR,'IRRG_RATE_SPR',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,IRRG_RATE_DRP,'IRRG_RATE_DRP',RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,IRRG_RATE_PDY,'IRRG_RATE_PDY',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,IRRG_RATE_FRW,'IRRG_RATE_FRW',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,IRRG_RATE_PDY,'IRRG_RATE_PDY',RC=STATUS); VERIFY_(STATUS) ! ----------------------------------------------------- ! INTERNAL Pointers @@ -6962,12 +6962,12 @@ subroutine Driver ( RC ) where (IRRG_RATE_DRP > 0) RZEXC = RZEXC + IRRG_RATE_DRP * DT end where - where (IRRG_RATE_PDY > 0) - SRFEXC = SRFEXC + IRRG_RATE_PDY * DT - end where where (IRRG_RATE_FRW > 0) RZEXC = RZEXC + IRRG_RATE_FRW * DT end where + where (IRRG_RATE_PDY > 0) + SRFEXC = SRFEXC + IRRG_RATE_PDY * DT + end where ! IRRGRR: add call to catch_calc_soil_moist() diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 5c3ee63d9..ff215d347 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -608,7 +608,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! LAI based trigger: scale soil moisture to LAI seasonal cycle ! ============================================================ - call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & + call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_FRW,IRRG_RATE_PDY, & IRRG_IRRIGFRAC,IRRG_PADDYFRAC,SRATE,DRATE,FRATE) else @@ -616,7 +616,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) ! crop calendar based irrigation ! ============================== - call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & + call IM%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_FRW,IRRG_RATE_PDY, & IRRG_CROPIRRIGFRAC,SRATE,DRATE,FRATE) endif @@ -629,7 +629,7 @@ subroutine INITIALIZE (GC,IMPORT, EXPORT, CLOCK, RC ) IRRG_RATE_FRW = IRRG_RATE_FRW * IRRG_IRRIGFRAC IRRG_RATE_PDY = IRRG_RATE_PDY * IRRG_PADDYFRAC - if(associated(IRRG_RATE_TOT)) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW +IRRG_RATE_PDY + IRRG_RATE_DRP + if(associated(IRRG_RATE_TOT)) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_DRP + IRRG_RATE_FRW +IRRG_RATE_PDY call MAPL_TimerOff(MAPL,"INITIALIZE") RETURN_(ESMF_SUCCESS) @@ -759,8 +759,8 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! ------------------------------- call MAPL_GetPointer(EXPORT, IRRG_RATE_SPR ,'IRRG_RATE_SPR', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, IRRG_RATE_DRP ,'IRRG_RATE_DRP', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY ,'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, IRRG_RATE_FRW ,'IRRG_RATE_FRW', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, IRRG_RATE_PDY ,'IRRG_RATE_PDY', ALLOC=.true., RC=STATUS) ; VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, IRRG_RATE_TOT ,'IRRG_RATE_TOT', RC=STATUS) ; VERIFY_(STATUS) @@ -850,7 +850,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) call IM%run_model(IRRG_METHOD, local_hour, & IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & SMWP,SMSAT,SMREF,SMCNT, LAI, IRRG_LAIMIN, IRRG_LAIMAX, RZDEF, & - IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, & SRATE, DRATE, FRATE) else @@ -862,7 +862,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & IRRG_CROPIRRIGFRAC,IRRG_DOY_PLANT,IRRG_DOY_HARVEST,IRRG_TYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, & SRATE, DRATE, FRATE) endif @@ -875,7 +875,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) IRRG_RATE_FRW = IRRG_RATE_FRW * IRRG_IRRIGFRAC IRRG_RATE_PDY = IRRG_RATE_PDY * IRRG_PADDYFRAC - if(associated(IRRG_RATE_TOT)) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_FRW +IRRG_RATE_PDY + IRRG_RATE_DRP + if(associated(IRRG_RATE_TOT)) IRRG_RATE_TOT = IRRG_RATE_SPR + IRRG_RATE_DRP + IRRG_RATE_FRW +IRRG_RATE_PDY deallocate (local_hour, SMWP, SMSAT, SMREF, SMCNT, RZDEF, IM) @@ -885,3 +885,6 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) end subroutine RUN end module GEOS_IrrigationGridCompMod + + +! ========================= EOF ================================================================================== diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 84346fc77..fad5e3a48 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -32,7 +32,8 @@ MODULE IRRIGATION_MODULE ! 1) IRRG_RATE_SPR [kg m-2 s-1] ! 2) IRRG_RATE_DRP [kg m-2 s-1] ! 3) IRRG_RATE_FRW [kg m-2 s-1] - ! 4) IRRG_RATE_PDY [kg m-2 s-1] + ! 4) IRRG_RATE_PDY [kg m-2 s-1] + ! 5) IRRG_RATE_TOT [kg m-2 s-1] (diagnostic only) ! ! (2) IRRIGATED AND PADDY TILES: ! During land BC's generation, the fraction of irrigated crops and paddy is set to zero @@ -164,8 +165,8 @@ MODULE IRRIGATION_MODULE ! public procedure, public :: init_model - generic, public :: run_model => irrigrate_lai_trigger, irrigrate_crop_calendar - generic, public :: update_irates => update_irates_lai, update_irates_ccalendar + generic, public :: run_model => irrigrate_lai_trigger, irrigrate_crop_calendar + generic, public :: update_irates => update_irates_lai, update_irates_ccalendar ! private procedure, private :: irrigrate_lai_trigger @@ -216,7 +217,7 @@ END SUBROUTINE init_model SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, & IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & SMWP, SMSAT, SMREF, SMCNT, LAI, IRRG_LAIMIN,IRRG_LAIMAX, RZDEF, & - IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, & + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, & SRATE, DRATE, FRATE) implicit none @@ -340,8 +341,8 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, ! IRRGRR, this seems outdated: IRRG_RATE_PDY is weighted averaged over irrigated crops + paddy fractions. - call this%update_irates (IRRG_RATE_SPR, IRRG_RATE_DRP,IRRG_RATE_PDY, IRRG_RATE_FRW, & - IRRG_IRRIGFRAC,IRRG_PADDYFRAC,SRATE,DRATE,FRATE) + call this%update_irates( IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, & + IRRG_IRRIGFRAC, IRRG_PADDYFRAC, SRATE, DRATE, FRATE ) END SUBROUTINE irrigrate_lai_trigger @@ -351,7 +352,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & IRRG_CROPIRRIGFRAC,IRRG_DOY_PLANT, IRRG_DOY_HARVEST, IRRG_TYPE , & SMWP,SMSAT,SMREF,SMCNT, RZDEF, & - IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW, SRATE, DRATE, FRATE) + IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, SRATE, DRATE, FRATE) implicit none class(irrigation_model),intent(inout):: this @@ -487,29 +488,31 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & ! Update IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY EXPORTS to be sent to land models ! They are weighted averaged over 26 crop fractions. - call this%update_irates (IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & - IRRG_CROPIRRIGFRAC,SRATE,DRATE,FRATE) + call this%update_irates( IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, & + IRRG_CROPIRRIGFRAC, SRATE, DRATE, FRATE ) END SUBROUTINE irrigrate_crop_calendar ! ---------------------------------------------------------------------------- - SUBROUTINE update_irates_lai (this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & + SUBROUTINE update_irates_lai (this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_FRW,IRRG_RATE_PDY, & IRRG_IRRIGFRAC,IRRG_PADDYFRAC,SRATE,DRATE,FRATE) implicit none - class(irrigation_model),intent(inout):: this - real, dimension (:), intent (in) :: IRRG_IRRIGFRAC, IRRG_PADDYFRAC - real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE - real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY - integer :: N, NT + class(irrigation_model), intent(inout) :: this + + real, dimension(:), intent(in) :: IRRG_IRRIGFRAC, IRRG_PADDYFRAC + real, dimension(:,:), intent(in) :: SRATE, DRATE, FRATE + real, dimension(:), intent(inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY + + integer :: N, NT ! INITIALIZE EXPORTS IRRG_RATE_SPR = 0. IRRG_RATE_DRP = 0. - IRRG_RATE_PDY = 0. IRRG_RATE_FRW = 0. + IRRG_RATE_PDY = 0. NT = size (IRRG_IRRIGFRAC) @@ -528,35 +531,38 @@ END SUBROUTINE update_irates_lai !............................................................................... - SUBROUTINE update_irates_ccalendar(this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_PDY,IRRG_RATE_FRW, & + SUBROUTINE update_irates_ccalendar(this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_FRW,IRRG_RATE_PDY, & IRRG_CROPIRRIGFRAC,SRATE,DRATE,FRATE) implicit none - class(irrigation_model),intent(inout):: this - real, dimension(:,:), intent (in) :: IRRG_CROPIRRIGFRAC ! IRRG_NCROPS - real, dimension (:,:), intent (in) :: SRATE, DRATE, FRATE - real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_PDY, IRRG_RATE_FRW - integer :: N, NT, crop + + class(irrigation_model), intent(inout) :: this + + real, dimension(:,:), intent (in) :: IRRG_CROPIRRIGFRAC ! IRRG_NCROPS + real, dimension(:,:), intent (in) :: SRATE, DRATE, FRATE + real, dimension(:), intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY + + integer :: N, NT, crop ! INITIALIZE EXPORTS IRRG_RATE_SPR = 0. IRRG_RATE_DRP = 0. - IRRG_RATE_PDY = 0. IRRG_RATE_FRW = 0. + IRRG_RATE_PDY = 0. !_ASSERT(size (SRATE,2)==IRRG_NCROPS,'Irrigation model crop calendar trigger IRRG_NCROPS mismatch') - NT = size (IRRG_RATE_SPR) + NT = size (IRRG_RATE_SPR) DO N = 1, NT if(SUM(IRRG_CROPIRRIGFRAC(N,:)) > 0.) then DO crop = 1, IRRG_NCROPS - IRRG_RATE_SPR(N) = IRRG_RATE_SPR(N) + SRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) - IRRG_RATE_DRP(N) = IRRG_RATE_DRP(N) + DRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) - if (crop==3) then - ! If crop is rice (crop ==3) then use flood irrigation. Otherwise use furrow irrigation. - IRRG_RATE_PDY(N) = IRRG_RATE_PDY(N) + FRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) - else - IRRG_RATE_FRW(N) = IRRG_RATE_FRW(N) + FRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) - endif + IRRG_RATE_SPR(N) = IRRG_RATE_SPR(N) + SRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) + IRRG_RATE_DRP(N) = IRRG_RATE_DRP(N) + DRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) + if (crop==3) then + ! If crop is rice (crop ==3) then use flood irrigation. Otherwise use furrow irrigation. + IRRG_RATE_PDY(N) = IRRG_RATE_PDY(N) + FRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) + else + IRRG_RATE_FRW(N) = IRRG_RATE_FRW(N) + FRATE (N,crop)*IRRG_CROPIRRIGFRAC(N,crop)/SUM(IRRG_CROPIRRIGFRAC(N,:)) + endif END DO endif END DO From acc3eac93ec11666dc5b375b2f3584fca2122763 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 29 Jul 2025 17:38:36 -0400 Subject: [PATCH 40/55] irrigation: changed rc variable names (IRR_EFCOR->IRRG_EFCOR, MIDS_LENGTH->IRRG_MIDS_LNGTH); edited comments; fixed typos (irrigation_model.F90, GEOS_SurfaceGridComp.rc) --- .../irrigation_model.F90 | 27 +++++++++--------- .../Shared/GEOS_SurfaceGridComp.rc | 28 +++++++++---------- 2 files changed, 26 insertions(+), 29 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index fad5e3a48..8176c475f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -136,26 +136,25 @@ MODULE IRRIGATION_MODULE REAL :: irrig_thres = 0.01 ! threshold of tile fraction to turn the irrigation model on. REAL :: lai_thres = 0.6 ! threshold of LAI range to turn irrigation on - REAL :: efcor = 25.0 ! Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use) - REAL :: MIDS_LENGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER: 1) + REAL :: efcor = 25.0 ! efficiency correction (% water loss: efcor = 0% denotes 100% efficient water use) + REAL :: MIDS_LNGTH = 0.6 ! Mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER: 1) ! Sprinkler parameters ! -------------------- - REAL :: sprinkler_stime = 6.0 ! sprinkler irrigatrion start time [hours] - REAL :: sprinkler_dur = 4.0 ! sprinkler irrigation duration [hours] - REAL :: sprinkler_thres = 0.7 ! soil moisture threshhold to trigger sprinkler irrigation + REAL :: sprinkler_stime = 6.0 ! sprinkler irrigation start time (local) [hours] + REAL :: sprinkler_dur = 4.0 ! sprinkler irrigation duration [hours] + REAL :: sprinkler_thres = 0.7 ! soil moisture threshold to trigger sprinkler irrigation ! Drip parameters ! --------------- - REAL :: drip_stime = 8.0 ! drip irrigatrion start time [hours] - REAL :: drip_dur = 8.0 ! drip irrigation duration [hours] + REAL :: drip_stime = 8.0 ! drip irrigation start time (local) [hours] + REAL :: drip_dur = 8.0 ! drip irrigation duration [hours] ! Flood parameters ! ---------------- - REAL :: flood_stime = 6.0 ! flood irrigatrion start time [hours] - REAL :: flood_dur = 8.0 ! flood irrigation duration [hours] - REAL :: flood_thres = 0.6 ! soil moisture threshhold to trigger flood irrigation - + REAL :: flood_stime = 6.0 ! flood irrigation start time (local) [hours] + REAL :: flood_dur = 8.0 ! flood irrigation duration [hours] + REAL :: flood_thres = 0.6 ! soil moisture threshold to trigger flood irrigation end type irrig_params @@ -204,9 +203,9 @@ SUBROUTINE init_model (IP, SURFRC) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_STIME:' , VALUE=IP%flood_stime, DEFAULT=DP%flood_stime , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_DUR:' , VALUE=IP%flood_dur, DEFAULT=DP%flood_dur , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_THRES:' , VALUE=IP%flood_thres, DEFAULT=DP%flood_thres , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='IRR_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) ! IRRGRR - revise rc param name + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_LAI_THRES:' , VALUE=IP%lai_thres, DEFAULT=DP%lai_thres , __RC__ ) - CALL ESMF_ConfigGetAttribute (SCF, label='MIDS_LENGTH:' , VALUE=IP%MIDS_LENGTH, DEFAULT=DP%MIDS_LENGTH , __RC__ ) ! IRRGRR - revise rc param name + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_MIDS_LNGTH:', VALUE=IP%MIDS_LNGTH, DEFAULT=DP%MIDS_LNGTH , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FRAC_THRES:', VALUE=IP%irrig_thres, DEFAULT=DP%irrig_thres , __RC__ ) CALL ESMF_ConfigDestroy (SCF, __RC__) @@ -401,7 +400,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & ! IRRIGATED CROP: compute sum of irrigrates from 25 crops. - ROOTFRAC = CROP_SEASON_STAGE (this%MIDS_LENGTH, dofyr,NINT(IRRG_DOY_PLANT(N, sea, crop)),NINT(IRRG_DOY_HARVEST(N, sea, crop))) + ROOTFRAC = CROP_SEASON_STAGE (this%MIDS_LNGTH, dofyr,NINT(IRRG_DOY_PLANT(N, sea, crop)),NINT(IRRG_DOY_HARVEST(N, sea, crop))) if(SMREF(N) > SMWP(N))then ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) else diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc index 02ec74f9f..027d2a532 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc @@ -160,15 +160,13 @@ #--------------------------------------------------------# # ---- Run irrigation module - -# NOTE: The irrigation model needs the irrigation parameter file ('irrigation_IMxJM_DL.dat') in BCSDIR to run the model. -# 0 : Do NOT run irrigation module (default) -# 1 : YES, run irrigation module - # +# NOTE: The irrigation model needs the irrigation parameter file ('irrigation_IMxJM_DL.dat') in BCSDIR to run the model. +# 0 : Do NOT run irrigation module (default) +# 1 : YES, run irrigation module # # GEOSagcm=>RUN_IRRIG: 0 -# GEOSldas=>RUN_IRRIG: 1 -# +# GEOSldas=>RUN_IRRIG: 0 # # ---- Irrigation trigger # @@ -178,19 +176,19 @@ # GEOSagcm=>IRRG_TRIGGER: 0 # GEOSldas=>IRRG_TRIGGER: 0 # -# ---- Irrigation method (ONLY available with IRRG_TRIGGER: 0) +# ---- Irrigation method +# +# The LAI-based trigger (IRRG_TRIGGER: 0) offers 4 choices of irrigation method: # -# While the crop calendar based trigger uses crop-specific irrigation methods, the LAI-based trigger (IRRG_TRIGGER: 0) offers below -# 4 different irrigation methods to choose from: -# 0 : CONCURRENTLY Sprinkler, Flood, and DRIP irrigation methods on method specific tile fractions (default) +# 0 : CONCURRENT sprinkler, drip, and furrow irrigation for specified tile fractions (default) # 1 : Sprinkler irrigation on entire tile -# 2 : Drip irrigation on entire tile -# 3 : Flood irrigation on entire tile +# 2 : Drip irrigation on entire tile +# 3 : Furrow irrigation on entire tile # # GEOSagcm=>IRRG_METHOD: 0 # GEOSldas=>IRRG_METHOD: 0 # -# ----- Below default parameter values can also be changed via this resource file: +# ----- Miscellaneous irrigation parameters # # GEOSldas=>IRRG_FRAC_THRES: 0.01 # threshold of tile fraction to turn the irrigation model on. # GEOSldas=>IRRG_LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on @@ -202,8 +200,8 @@ # GEOSldas=>IRRG_FLD_STIME: 6.0 # flood irrigatrion start time [hours] # GEOSldas=>IRRG_FLD_DUR: 8.0 # flood irrigation duration [hours] # GEOSldas=>IRRG_FLD_THRES: 0.7 # soil moisture threshhold to trigger flood irrigation IRRGRR: Units??? -# GEOSldas=>IRR_EFCOR: 25.0 # Efficiency Correction (% water loss: efcor = 0% denotes 100% efficient water use ) -# GEOSldas=>MIDS_LENGTH: 0.6 # Mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER : 1) +# GEOSldas=>IRRG_EFCOR: 25.0 # efficiency correction (% water loss: efcor = 0% denotes 100% efficient water use ) +# GEOSldas=>IRRG_MIDS_LNGTH: 0.6 # mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER: 1) # # lengths of development and end seasons are assumed as (1 - MIDS_LENGTH) / 2. From 456b0aa5e5e89cf86686481b1eedf63258255e37 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 29 Jul 2025 17:57:56 -0400 Subject: [PATCH 41/55] added call to calc_soil_moist after application of irrigation water (GEOS_CatchCNCLM40GridComp.F90) --- .../GEOS_CatchCNCLM40GridComp.F90 | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index c9f538618..b4ef19280 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -4912,6 +4912,8 @@ subroutine Driver ( RC ) integer :: NTILES integer :: I, J, K, N + real, dimension(:), allocatable :: AR4 ! for catch_calc_soil_moist() after irrigation application + ! dummy variables for call to get snow temp real :: FICE @@ -6969,11 +6971,21 @@ subroutine Driver ( RC ) SRFEXC = SRFEXC + IRRG_RATE_PDY * DT end where - ! IRRGRR: add call to catch_calc_soil_moist() + ! after application of irrigation water, make sure soil moisture prognostics + ! (srfexc, rzexc, catdef) remain valid + ! TO-DO IRRGRR: add optional werror to close water balance + + allocate(ar4(NTILES)) + + call catch_calc_soil_moist( & + NTILES, dzsf_in_mm, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + srfexc, rzexc, catdef, ar1, ar2, ar4 ) + + deallocate(ar4) ENDIF - #ifdef DBG_CNLSM_INPUTS call MAPL_Get(MAPL, LocStream=LOCSTREAM, RC=STATUS) From fcffb325e92906163e1e91f3ff4544c3bbf8fe59 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 29 Jul 2025 17:58:33 -0400 Subject: [PATCH 42/55] cleaned up obsolete comment (irrigation_model.F90) --- .../GEOSirrigation_GridComp/irrigation_model.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 8176c475f..ddba0ceeb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -337,8 +337,6 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, END DO TILE_LOOP ! Update IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY EXPORTS to be sent to land models. - - ! IRRGRR, this seems outdated: IRRG_RATE_PDY is weighted averaged over irrigated crops + paddy fractions. call this%update_irates( IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, & IRRG_IRRIGFRAC, IRRG_PADDYFRAC, SRATE, DRATE, FRATE ) From e817fbea0652ef3938464eca2867d17177ce9b4e Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 11:53:19 -0400 Subject: [PATCH 43/55] added spurious water balance term for irrigation to capture irrigation water rejected by Catchment --- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 7 +++ .../GEOS_CatchCNGridComp.F90 | 2 + .../GEOS_CatchCNCLM40GridComp.F90 | 60 ++++++++++++------- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 26 ++++++-- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 3 +- 5 files changed, 72 insertions(+), 26 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index e60f9cafe..8a137bef9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -695,6 +695,11 @@ subroutine SetServices ( GC, RC ) CHILD_ID = CATCH(1), & RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, & + SHORT_NAME = 'SPIRRG', & + CHILD_ID = CATCH(1), & + RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, & SHORT_NAME = 'WESNN1', & CHILD_ID = CATCH(1), & @@ -1174,6 +1179,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPSNOW' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPIRRG' , CHILD_ID = CATCHCN(1), RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'WESNN1' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'WESNN2' , CHILD_ID = CATCHCN(1), RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index f809570d2..c888d20ea 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -880,6 +880,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPSNOW' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'SPIRRG' , CHILD_ID = CATCHCN, RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'WESNN1' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'WESNN2' , CHILD_ID = CATCHCN, RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index a6e1fe72a..bb4639ece 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -3129,6 +3129,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SPIRRG', & + LONG_NAME = 'Spurious_irrigation_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& LONG_NAME = 'vegetation_type' ,& UNITS = '1' ,& @@ -4731,6 +4740,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: SPLAND real, dimension(:), pointer :: SPWATR real, dimension(:), pointer :: SPSNOW + real, dimension(:), pointer :: SPIRRG real, dimension(:), pointer :: CNLAI real, dimension(:), pointer :: CNTLAI @@ -4819,7 +4829,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: UUU, RHO real,pointer,dimension(:) :: LAI0,GRN0,ZVG real,pointer,dimension(:) :: Z0, D0 - real,pointer,dimension(:) :: sfmc, rzmc, prmc, entot, wtot + real,pointer,dimension(:) :: sfmc, rzmc, prmc, werror, entot, wtot real,pointer,dimension(:) :: ghflxsno, ghflxtskin real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW @@ -5373,6 +5383,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SPLAND, 'SPLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SPWATR, 'SPWATR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SPSNOW, 'SPSNOW' , RC=STATUS); VERIFY_(STATUS) + if(CATCHCN_INTERNAL%RUN_IRRIG /= 0) & + call MAPL_GetPointer(EXPORT,SPIRRG, 'SPIRRG' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNLAI, 'CNLAI' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNTLAI, 'CNTLAI' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNSAI, 'CNSAI' , RC=STATUS); VERIFY_(STATUS) @@ -5616,7 +5628,8 @@ subroutine Driver ( RC ) allocate(SFMC (NTILES)) allocate(RZMC (NTILES)) allocate(PRMC (NTILES)) - allocate(ENTOT (NTILES)) + allocate(werror (NTILES)) + allocate(ENTOT (NTILES)) allocate(ghflxsno (NTILES)) allocate(ghflxtskin(NTILES)) allocate(WTOT (NTILES)) @@ -6966,35 +6979,40 @@ subroutine Driver ( RC ) ! Add irrigation model imports ! -------------------------------------------------------------------------- - IF ((catchcn_internal%RUN_IRRIG /= 0)) THEN - where (IRRG_RATE_SPR > 0) - PLS_IN = PLS_IN + IRRG_RATE_SPR - end where - where (IRRG_RATE_DRP > 0) - RZEXC = RZEXC + IRRG_RATE_DRP * DT - end where - where (IRRG_RATE_FRW > 0) - RZEXC = RZEXC + IRRG_RATE_FRW * DT - end where - where (IRRG_RATE_PDY > 0) - SRFEXC = SRFEXC + IRRG_RATE_PDY * DT - end where - - ! after application of irrigation water, make sure soil moisture prognostics - ! (srfexc, rzexc, catdef) remain valid - ! TO-DO IRRGRR: add optional werror to close water balance + IF ((CATCHCN_INTERNAL%RUN_IRRIG /= 0)) THEN + + where (IRRG_RATE_SPR > 0) + PLS_IN = PLS_IN + IRRG_RATE_SPR + end where + where (IRRG_RATE_DRP > 0) + RZEXC = RZEXC + IRRG_RATE_DRP * DT + end where + where (IRRG_RATE_FRW > 0) + RZEXC = RZEXC + IRRG_RATE_FRW * DT + end where + where (IRRG_RATE_PDY > 0) + SRFEXC = SRFEXC + IRRG_RATE_PDY * DT + end where + + ! after application of irrigation water, make sure soil moisture prognostics + ! (srfexc, rzexc, catdef) remain valid; + ! werror accounts for excess irrigation that cannot be absorbed by the soil; + ! sfmc, rzmc, prmc here are dummies that are required to get werror allocate(ar4(NTILES)) call catch_calc_soil_moist( & NTILES, dzsf_in_mm, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & - srfexc, rzexc, catdef, ar1, ar2, ar4 ) + srfexc, rzexc, catdef, ar1, ar2, ar4, & + sfmc, rzmc, prmc, werror ) deallocate(ar4) + SPIRRG = -werror / DT ! add excess irrigation into spurious term + ENDIF - + #ifdef DBG_CNLSM_INPUTS call MAPL_Get(MAPL, LocStream=LOCSTREAM, RC=STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index b8a47e0ec..5cefb1fcc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -2669,6 +2669,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SPIRRG', & + LONG_NAME = 'Spurious_irrigation_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& LONG_NAME = 'vegetation_type' ,& UNITS = '1' ,& @@ -4297,6 +4306,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: SPLH real, dimension(:), pointer :: SPWATR real, dimension(:), pointer :: SPSNOW + real, dimension(:), pointer :: SPIRRG real, dimension(:), pointer :: WAT10CM real, dimension(:), pointer :: WATSOI @@ -4353,7 +4363,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: UUU, RHO real,pointer,dimension(:) :: LAI0,GRN0,ZVG real,pointer,dimension(:) :: Z0, D0 - real,pointer,dimension(:) :: sfmc, rzmc, prmc, entot, wtot + real,pointer,dimension(:) :: sfmc, rzmc, prmc, werror, entot, wtot real,pointer,dimension(:) :: ghflxsno, ghflxtskin real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW @@ -4874,6 +4884,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,SPLH, 'SPLH' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SPWATR, 'SPWATR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SPSNOW, 'SPSNOW' , RC=STATUS); VERIFY_(STATUS) + if(CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) & + call MAPL_GetPointer(EXPORT,SPIRRG, 'SPIRRG' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTDU001,'RMELTDU001', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTDU002,'RMELTDU002', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTDU003,'RMELTDU003', RC=STATUS); VERIFY_(STATUS) @@ -4933,6 +4945,7 @@ subroutine Driver ( RC ) allocate(SFMC (NTILES)) allocate(RZMC (NTILES)) allocate(PRMC (NTILES)) + allocate(werror (NTILES)) allocate(ENTOT (NTILES)) allocate(ghflxsno (NTILES)) allocate(ghflxtskin(NTILES)) @@ -5607,6 +5620,7 @@ subroutine Driver ( RC ) ! -------------------------------------------------------------------------- if(CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) then + where (IRRG_RATE_SPR > 0) PLS_IN = PLS_IN + IRRG_RATE_SPR end where @@ -5621,17 +5635,21 @@ subroutine Driver ( RC ) end where ! after application of irrigation water, make sure soil moisture prognostics - ! (srfexc, rzexc, catdef) remain valid - ! TO-DO IRRGRR: add optional werror to close water balance + ! (srfexc, rzexc, catdef) remain valid; + ! werror accounts for excess irrigation that cannot be absorbed by the soil; + ! sfmc, rzmc, prmc here are dummies that are required to get werror allocate(ar4(NTILES)) call catch_calc_soil_moist( & NTILES, dzsf_in_mm, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & - srfexc, rzexc, catdef, ar1, ar2, ar4 ) + srfexc, rzexc, catdef, ar1, ar2, ar4, & + sfmc, rzmc, prmc, werror ) deallocate(ar4) + + SPIRRG = -werror / DT ! add excess irrigation into spurious term endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 603ff013a..8bbd75581 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -1744,8 +1744,9 @@ subroutine catch_calc_soil_moist( & ! On input, also check validity of prognostic excess/deficit variables ! and modify if necessary. Perturbed or updated excess/deficit variables ! in data assimilation integrations may be unphysical. + ! ! Optional output "werror" contains excess or missing water related - ! to inconsistency. + ! to inconsistency. REQUIRES presence of optional "sfmc", "rzmc", and "prmc". ! ! Optional outputs "smfcun", "rzmcun", "prmcun" are surface, ! root zone, and profile moisture content for unsaturated areas only, From d93d833ce567fc3b6d29fcbc9fde1fda1a5a2068 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 12:54:39 -0400 Subject: [PATCH 44/55] rename dzsf -> dzsf_in_mm to fix build error in previous commit and make code more consistent with current develop version (GEOS_CatchCNCLM40GridComp.F90) --- .../GEOS_CatchCNCLM40GridComp.F90 | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index bb4639ece..d7594a4b5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -4811,7 +4811,7 @@ subroutine Driver ( RC ) ! -------------------------------------------------------------------------- INTEGER,pointer,dimension(:) :: CAT_ID - real,pointer,dimension(:) :: dzsf + real,pointer,dimension(:) :: dzsf_in_mm real,pointer,dimension(:) :: swnetfree real,pointer,dimension(:) :: swnetsnow real,pointer,dimension(:) :: qa1 @@ -5599,7 +5599,7 @@ subroutine Driver ( RC ) allocate(FICESOUT(N_SNOW,NTILES)) allocate(TILEZERO (NTILES)) - allocate(DZSF (NTILES)) + allocate(DZSF_IN_MM (NTILES)) allocate(SWNETFREE(NTILES)) allocate(SWNETSNOW(NTILES)) allocate(VEG1 (NTILES)) @@ -5813,7 +5813,7 @@ subroutine Driver ( RC ) ! surface layer depth for soil moisture ! -------------------------------------------------------------------------- - DZSF( :) = catchcn_internal%SURFLAY + DZSF_IN_MM( :) = catchcn_internal%SURFLAY ! same as DZSF but in units of [mm] ! -------------------------------------------------------------------------- ! build arrays from internal state @@ -6278,7 +6278,7 @@ subroutine Driver ( RC ) ! gkw: obtain catchment area fractions and soil moisture ! ------------------------------------------------------ - call catch_calc_soil_moist( ntiles, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + call catch_calc_soil_moist( ntiles, dzsf_in_mm, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc ) @@ -7119,7 +7119,7 @@ subroutine Driver ( RC ) call MAPL_VarWrite(unit, tilegrid, VEG2, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, FVEG1, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, FVEG2, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, DZSF, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DZSF_IN_MM, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, BF1, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, BF2, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, BF3, mask=mask, rc=status); VERIFY_(STATUS) @@ -7199,7 +7199,7 @@ subroutine Driver ( RC ) if (ntiles > 0) then call CATCHCN ( NTILES, LONS, LATS, DT,catchcn_internal%USE_FWET_FOR_RUNOFF, & ! LONS, LATS are in [radians] !!! - catchcn_internal%FWETC, catchcn_internal%FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF ,& + catchcn_internal%FWETC, catchcn_internal%FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF_IN_MM ,& PCU , PLS_IN , SNO, ICE, FRZR ,& UUU ,& @@ -7599,7 +7599,7 @@ subroutine Driver ( RC ) deallocate(SNDZN ) deallocate(FICESOUT ) deallocate(TILEZERO ) - deallocate(DZSF ) + deallocate(DZSF_IN_MM ) deallocate(SWNETFREE) deallocate(SWNETSNOW) deallocate(VEG1 ) @@ -7954,7 +7954,7 @@ subroutine RUN0(gc, import, export, clock, rc) !! Miscellaneous integer :: ntiles, nv, nz real, allocatable :: dummy(:) - real, allocatable :: dzsf(:), ar1(:), ar2(:), wesnn(:,:) + real, allocatable :: dzsf_in_mm(:), ar1(:), ar2(:), wesnn(:,:) real, allocatable :: catdefcp(:), srfexccp(:), rzexccp(:) real, allocatable :: VEG1(:), VEG2(:) integer, allocatable :: ityp(:,:,:) @@ -8162,14 +8162,14 @@ subroutine RUN0(gc, import, export, clock, rc) emis = emis*(1.-asnow) + EMSSNO*asnow ! Compute FR - ! Step 1: set dzsf + ! Step 1: set dzsf_in_mm ! Step 2: compute ar1, ar2 via call to catch_calc_soil_moist() ! Step 3: compute fr ! -step-1- - allocate(dzsf(ntiles), stat=status) + allocate(dzsf_in_mm(ntiles), stat=status) VERIFY_(status) - dzsf = catchcn_internal%SURFLAY + dzsf_in_mm = catchcn_internal%SURFLAY ! -step-2- allocate(ar1(ntiles), stat=status) @@ -8189,7 +8189,7 @@ subroutine RUN0(gc, import, export, clock, rc) rzexccp = rzexc call catch_calc_soil_moist( & ! intent(in) - ntiles, dzsf, vgwmax, cdcr1, cdcr2, & + ntiles, dzsf_in_mm, vgwmax, cdcr1, cdcr2, & psis, bee, poros, wpwet, & ars1, ars2, ars3, & ara1, ara2, ara3, ara4, & @@ -8222,7 +8222,7 @@ subroutine RUN0(gc, import, export, clock, rc) if (allocated(srfexccp)) deallocate(srfexccp) if (allocated(rzexccp)) deallocate(rzexccp) if (allocated(dummy)) deallocate(dummy) - if (allocated(dzsf)) deallocate(dzsf) + if (allocated(dzsf_in_mm)) deallocate(dzsf_in_mm) if (allocated(ar1)) deallocate(ar1) if (allocated(ar2)) deallocate(ar2) if (allocated(wesnn)) deallocate(wesnn) From 85de0e67a204df9da8a29096b39a05837fe58f9e Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 13:22:20 -0400 Subject: [PATCH 45/55] removed obsolete comment re. irrigation (GEOS_CatchCNCLM45GridComp.F90) --- .../GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index bbf0e40a8..bfd249ca3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -7260,8 +7260,6 @@ subroutine Driver ( RC ) where (IRRG_RATE_FRW > 0) RZEXC = RZEXC + IRRG_RATE_FRW * DT end where - - ! IRRGRR: add call to catch_calc_soil_moist() ENDIF From 5cfebed88eaf022b9cf299d355417b188db3a00c Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 13:22:50 -0400 Subject: [PATCH 46/55] clarified comments re. soil moisture thresholds for irrigation (GEOS_SurfaceGridComp.rc) --- .../GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc index 5263d343b..71189d977 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc @@ -197,12 +197,12 @@ # GEOSldas=>IRRG_LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on # GEOSldas=>IRRG_SPR_STIME: 6.0 # sprinkler irrigatrion start time [hours] # GEOSldas=>IRRG_SPR_DUR: 4.0 # sprinkler irrigation duration [hours] -# GEOSldas=>IRRG_SPR_THRES: 0.7 # soil moisture threshhold to trigger sprinkler irrigation IRRGRR: Units??? +# GEOSldas=>IRRG_SPR_THRES: 0.7 # threshold for soil moisture availability ("MA", dim-less) to trigger sprinkler irrigation # GEOSldas=>IRRG_DRP_STIME: 8.0 # drip irrigatrion start time [hours] # GEOSldas=>IRRG_DRP_DUR: 8.0 # drip irrigation duration [hours] # GEOSldas=>IRRG_FLD_STIME: 6.0 # flood irrigatrion start time [hours] # GEOSldas=>IRRG_FLD_DUR: 8.0 # flood irrigation duration [hours] -# GEOSldas=>IRRG_FLD_THRES: 0.7 # soil moisture threshhold to trigger flood irrigation IRRGRR: Units??? +# GEOSldas=>IRRG_FLD_THRES: 0.7 # threshold for soil moisture availability ("MA", dim-less) to trigger flood irrigation # GEOSldas=>IRRG_EFCOR: 25.0 # efficiency correction (% water loss: efcor = 0% denotes 100% efficient water use ) # GEOSldas=>IRRG_MIDS_LNGTH: 0.6 # mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER: 1) # # lengths of development and end seasons are assumed as (1 - MIDS_LENGTH) / 2. From f747b96155fa5c123d12266a8f4bee40fc4b510a Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 13:28:30 -0400 Subject: [PATCH 47/55] clarified precip inputs to Catchment in presence of irrigation (GEOS_CatchGridComp.F90, GEOS_CatchCNCLM40GridComp.F90) --- .../GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 | 6 +++--- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index d7594a4b5..a83139999 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -5691,7 +5691,7 @@ subroutine Driver ( RC ) allocate(QA1_0 (NTILES)) allocate(QA2_0 (NTILES)) allocate(QA4_0 (NTILES)) - allocate(PLS_IN (NTILES)) + allocate(PLS_IN (NTILES)) call ESMF_VMGetCurrent ( VM, RC=STATUS ) @@ -6973,8 +6973,8 @@ subroutine Driver ( RC ) ! gkw: end of main CN block - PLS_IN = PLS - + PLS_IN = PLS ! PLS_IN = large-scale precip plus sprinkler irrigation (if present, see below) + ! -------------------------------------------------------------------------- ! Add irrigation model imports ! -------------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 5cefb1fcc..5480e567a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5613,7 +5613,7 @@ subroutine Driver ( RC ) TILEZERO = 0.0 - PLS_IN = PLS + PLS_IN = PLS ! PLS_IN = large-scale precip plus sprinkler irrigation (if present, see below) ! -------------------------------------------------------------------------- ! Add irrigation model imports From 58bd30343f1a5b092e8c14ad966a08834c1a8c42 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 14:41:36 -0400 Subject: [PATCH 48/55] added irrigation "drip_threshold" (IRRG_DRP_THRES) for clarity; edited comments (GEOS_IrrigationGridComp.F90, irrigation_model.F90, GEOS_SurfaceGridComp.rc) --- .../GEOS_IrrigationGridComp.F90 | 8 ++++- .../irrigation_model.F90 | 27 ++++++++++------ .../Shared/GEOS_SurfaceGridComp.rc | 32 +++++++++++-------- 3 files changed, 44 insertions(+), 23 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index ff215d347..03a40faf5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -280,9 +280,13 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartRequired ,& RC=STATUS ) VERIFY_(STATUS) + + ! NOTE: UNGRIDDED_DIMS for SRATE, DRATE, and FRATE internal specs depends on IRRG_TRIGGER if (IRRG_TRIGGER == 0) then - ! only two crop types: irrigated crops and paddy in that order. + + ! UNGRIDDED_DIMS = 2: irrigated crops (sprinkler/drip/furrow) and paddy (in order) + call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'SRATE' ,& LONG_NAME ='crop_specific_irrigation_flux_sprinkler',& @@ -320,6 +324,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) elseif (IRRG_TRIGGER == 1) then + + ! UNGRIDDED_DIMS = 26 crops of crop calendar call MAPL_AddInternalSpec(GC ,& SHORT_NAME = 'SRATE' ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index ddba0ceeb..54c147deb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -141,20 +141,23 @@ MODULE IRRIGATION_MODULE ! Sprinkler parameters ! -------------------- - REAL :: sprinkler_stime = 6.0 ! sprinkler irrigation start time (local) [hours] - REAL :: sprinkler_dur = 4.0 ! sprinkler irrigation duration [hours] - REAL :: sprinkler_thres = 0.7 ! soil moisture threshold to trigger sprinkler irrigation + REAL :: sprinkler_stime = 6.0 ! sprinkler irrigation start time (local) [hours] + REAL :: sprinkler_dur = 4.0 ! sprinkler irrigation duration [hours] + REAL :: sprinkler_thres = 0.7 ! threshold for soil moisture availability ("MA") to trigger sprinkler irrigation [dim-less] ! Drip parameters ! --------------- - REAL :: drip_stime = 8.0 ! drip irrigation start time (local) [hours] - REAL :: drip_dur = 8.0 ! drip irrigation duration [hours] + REAL :: drip_stime = 8.0 ! drip irrigation start time (local) [hours] + REAL :: drip_dur = 8.0 ! drip irrigation duration [hours] + REAL :: drip_thres = 0.7 ! threshold for soil moisture availability ("MA") to trigger drip irrigation [dim-less] ! Flood parameters ! ---------------- - REAL :: flood_stime = 6.0 ! flood irrigation start time (local) [hours] - REAL :: flood_dur = 8.0 ! flood irrigation duration [hours] - REAL :: flood_thres = 0.6 ! soil moisture threshold to trigger flood irrigation + REAL :: flood_stime = 6.0 ! flood irrigation start time (local) [hours] + REAL :: flood_dur = 8.0 ! flood irrigation duration [hours] + REAL :: flood_thres = 0.6 ! threshold for soil moisture availability ("MA") to trigger flood irrigation [dim-less] + + end type irrig_params @@ -194,15 +197,21 @@ SUBROUTINE init_model (IP, SURFRC) Iam='IRRIGATION_MODULE: init_model' SCF = ESMF_ConfigCreate(__RC__) + CALL ESMF_ConfigLoadFile (SCF,SURFRC,rc=status) ; VERIFY_(STATUS) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_SPR_STIME:' , VALUE=IP%sprinkler_stime, DEFAULT=DP%sprinkler_stime, __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_SPR_DUR:' , VALUE=IP%sprinkler_dur, DEFAULT=DP%sprinkler_dur , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_SPR_THRES:' , VALUE=IP%sprinkler_thres, DEFAULT=DP%sprinkler_thres, __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_DRP_STIME:' , VALUE=IP%drip_stime, DEFAULT=DP%drip_stime , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_DRP_DUR:' , VALUE=IP%drip_dur, DEFAULT=DP%drip_dur , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_DRP_THRES:' , VALUE=IP%drip_thres, DEFAULT=DP%drip_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_STIME:' , VALUE=IP%flood_stime, DEFAULT=DP%flood_stime , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_DUR:' , VALUE=IP%flood_dur, DEFAULT=DP%flood_dur , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_FLD_THRES:' , VALUE=IP%flood_thres, DEFAULT=DP%flood_thres , __RC__ ) + CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_EFCOR:' , VALUE=IP%efcor, DEFAULT=DP%efcor , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_LAI_THRES:' , VALUE=IP%lai_thres, DEFAULT=DP%lai_thres , __RC__ ) CALL ESMF_ConfigGetAttribute (SCF, label='IRRG_MIDS_LNGTH:', VALUE=IP%MIDS_LNGTH, DEFAULT=DP%MIDS_LNGTH , __RC__ ) @@ -596,7 +605,7 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, ! DRIP IRRIGATION H1 = this%drip_stime H2 = this%drip_stime + this%drip_dur - IT = this%sprinkler_thres + IT = this%drip_thres if ((HC >= H1).AND.(HC < H2)) then ! use SMCNT at H1 during H1 <= HC < H2 to compute irrigrate. ! Notice drip uses the same soil moisture threshold of sprinkler but with 10.% efficiency correction. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc index 71189d977..817ce7392 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/GEOS_SurfaceGridComp.rc @@ -193,19 +193,25 @@ # # ----- Miscellaneous irrigation parameters # -# GEOSldas=>IRRG_FRAC_THRES: 0.01 # threshold of tile fraction to turn the irrigation model on. -# GEOSldas=>IRRG_LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on -# GEOSldas=>IRRG_SPR_STIME: 6.0 # sprinkler irrigatrion start time [hours] -# GEOSldas=>IRRG_SPR_DUR: 4.0 # sprinkler irrigation duration [hours] -# GEOSldas=>IRRG_SPR_THRES: 0.7 # threshold for soil moisture availability ("MA", dim-less) to trigger sprinkler irrigation -# GEOSldas=>IRRG_DRP_STIME: 8.0 # drip irrigatrion start time [hours] -# GEOSldas=>IRRG_DRP_DUR: 8.0 # drip irrigation duration [hours] -# GEOSldas=>IRRG_FLD_STIME: 6.0 # flood irrigatrion start time [hours] -# GEOSldas=>IRRG_FLD_DUR: 8.0 # flood irrigation duration [hours] -# GEOSldas=>IRRG_FLD_THRES: 0.7 # threshold for soil moisture availability ("MA", dim-less) to trigger flood irrigation -# GEOSldas=>IRRG_EFCOR: 25.0 # efficiency correction (% water loss: efcor = 0% denotes 100% efficient water use ) -# GEOSldas=>IRRG_MIDS_LNGTH: 0.6 # mid-season length as a fraction of crop growing season length (to be used with IRRG_TRIGGER: 1) -# # lengths of development and end seasons are assumed as (1 - MIDS_LENGTH) / 2. +# GEOSldas=>IRRG_FRAC_THRES: 0.01 # threshold of tile fraction to turn the irrigation model on +# GEOSldas=>IRRG_LAI_THRES: 0.6 # threshold of LAI range to turn irrigation on (for IRRG_TRIGGER: 0) +# +# GEOSldas=>IRRG_SPR_STIME: 6.0 # sprinkler irrigatrion start time [hours] +# GEOSldas=>IRRG_SPR_DUR: 4.0 # sprinkler irrigation duration [hours] +# GEOSldas=>IRRG_SPR_THRES: 0.7 # threshold for soil moisture availability ("MA") to trigger sprinkler irrigation [dim-less] +# +# GEOSldas=>IRRG_DRP_STIME: 8.0 # drip irrigatrion start time [hours] +# GEOSldas=>IRRG_DRP_DUR: 8.0 # drip irrigation duration [hours] +# GEOSldas=>IRRG_DRP_THRES: 0.7 # threshold for soil moisture availability ("MA") to trigger drip irrigation [dim-less] +# +# GEOSldas=>IRRG_FLD_STIME: 6.0 # flood irrigatrion start time [hours] +# GEOSldas=>IRRG_FLD_DUR: 8.0 # flood irrigation duration [hours] +# GEOSldas=>IRRG_FLD_THRES: 0.7 # threshold for soil moisture availability ("MA") to trigger flood irrigation [dim-less] +# +# GEOSldas=>IRRG_EFCOR: 25.0 # efficiency correction (% water loss: efcor = 0% denotes 100% efficient water use) +# GEOSldas=>IRRG_MIDS_LNGTH: 0.6 # mid-season length as fraction of crop growing season length (for IRRG_TRIGGER: 1); +# # length of development season = length of end season = (1 - MIDS_LENGTH)/2; +# # see function CROP_SEASON_STAGE() #--------------------------------------------------------# From 6677718300aad9692df1ac0f5171448c5020a77b Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 16:09:54 -0400 Subject: [PATCH 49/55] edited comments (GEOS_IrrigationGridComp.F90, irrigation_model.F90) --- .../GEOS_IrrigationGridComp.F90 | 6 +- .../irrigation_model.F90 | 103 +++++++++--------- 2 files changed, 57 insertions(+), 52 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 03a40faf5..68ff11537 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -795,8 +795,8 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) dayOfYear = dofyr , & rc=status ) VERIFY_(STATUS) - - call MAPL_Get (MAPL, TILELONS = LONS, & + + call MAPL_Get (MAPL, TILELONS = LONS, & ! longitude in [radians] INTERNAL_ESMF_STATE = INTERNAL, RC=STATUS ) VERIFY_(STATUS) @@ -822,7 +822,7 @@ subroutine RUN (GC,IMPORT, EXPORT, CLOCK, RC ) ! local time [hour] - local_hour(n) = AGCM_HH + AGCM_MI / 60. + AGCM_S / 3600. + 12.* (lons(n)/MAPL_PI) + local_hour(n) = AGCM_HH + AGCM_MI / 60. + AGCM_S / 3600. + 12.* (lons(n)/MAPL_PI) ! longitude in [radians] IF (local_hour(n) >= 24.) local_hour(n) = local_hour(n) - 24. IF (local_hour(n) < 0.) local_hour(n) = local_hour(n) + 24. T1 = CEILING (local_hour(n)) - DT/3600. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 54c147deb..b76554dcb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -259,71 +259,76 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, !----------------------------------------------------------------------------- ! Get the rootzone moisture availability to the plant !----------------------------------------------------------------------------- + if (IRRG_IRRIGFRAC(N) > 0.) then + if(SMREF(N) > SMWP(N))then - ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) + ma = (SMCNT(N) - SMWP(N)) /(SMREF(N) - SMWP(N)) else - ma = -1. + ma = -1. endif if(ma >= 0) then - - SELECT CASE (IRRG_METHOD) - CASE (0) ! CONCURRENTLY SPRINKER + FLOOD + FURROW + DRIP on corresponding fractions - - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - SRATE = SRATE (N,1), & - DRATE = DRATE (N,1), & - FRATE = FRATE (N,1)) - - SRATE (N,1) = SRATE (N,1)*IRRG_IRRIGFRAC_SPR(N) - DRATE (N,1) = DRATE (N,1)*IRRG_IRRIGFRAC_DRP (N) - FRATE (N,1) = FRATE (N,1)*IRRG_IRRIGFRAC_FRW (N) - - CASE (1) ! SPRINKLER only - - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - SRATE = SRATE (N,1)) - - DRATE (N,1) = 0. - FRATE (N,1) = 0. - - CASE (2) ! DRIP only - - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - DRATE = DRATE (N,1)) - - SRATE (N,1) = 0. - FRATE (N,1) = 0. - - CASE (3) ! FLOOD only - - call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & - FRATE = FRATE (N,1)) - - SRATE (N,1) = 0. - DRATE (N,1) = 0. - CASE DEFAULT - PRINT *, 'irrigrate_lai_trigger: IRRG_METHOD can be 0,1,2, or3' - CALL EXIT(1) - END SELECT + SELECT CASE (IRRG_METHOD) + + CASE (0) ! CONCURRENTLY SPRINKER + DRIP + FURROW + PADDY on corresponding fractions + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + SRATE = SRATE (N,1), & + DRATE = DRATE (N,1), & + FRATE = FRATE (N,1)) + + SRATE (N,1) = SRATE (N,1)*IRRG_IRRIGFRAC_SPR(N) + DRATE (N,1) = DRATE (N,1)*IRRG_IRRIGFRAC_DRP(N) + FRATE (N,1) = FRATE (N,1)*IRRG_IRRIGFRAC_FRW(N) + + CASE (1) ! SPRINKLER only + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + SRATE = SRATE (N,1)) + + DRATE (N,1) = 0. + FRATE (N,1) = 0. + + CASE (2) ! DRIP only + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + DRATE = DRATE (N,1)) + + SRATE (N,1) = 0. + FRATE (N,1) = 0. + + CASE (3) ! FURROW only + + call this%irrig_by_method (HC, ma, ROOTFRAC, SMCNT(N), SMREF(N), & + FRATE = FRATE (N,1)) + + SRATE (N,1) = 0. + DRATE (N,1) = 0. + + CASE DEFAULT + + PRINT *, 'irrigrate_lai_trigger: IRRG_METHOD can be 0,1,2, or3' + CALL EXIT(1) + + END SELECT endif endif - - if (IRRG_PADDYFRAC (N) > 0.) then + if (IRRG_PADDYFRAC (N) > 0.) then + H1 = this%flood_stime H2 = this%flood_stime + this%flood_dur if ((HC >= H1).AND.(HC < H2)) then - ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate for paddy. - if(H1 == HC) FRATE (N,2) = RZDEF(N) *0.1/(H2 - H1)/ 3600. - else - FRATE (N,2) = 0. + ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate for paddy. + if(H1 == HC) FRATE (N,2) = RZDEF(N) *0.1/(H2 - H1)/ 3600. + else + FRATE (N,2) = 0. endif SRATE (N,2) = 0. DRATE (N,2) = 0. - endif + endif ELSE From 94372285eba107daf5832dfa3d969a17df0a193b Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 16:15:25 -0400 Subject: [PATCH 50/55] avoid == for real numbers (irrigation_model.F90) --- .../GEOSirrigation_GridComp/irrigation_model.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index b76554dcb..acac25182 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -322,7 +322,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, H2 = this%flood_stime + this%flood_dur if ((HC >= H1).AND.(HC < H2)) then ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate for paddy. - if(H1 == HC) FRATE (N,2) = RZDEF(N) *0.1/(H2 - H1)/ 3600. + if(abs(H1 - HC) < 1./3600.) FRATE (N,2) = RZDEF(N) *0.1/(H2 - H1)/ 3600. else FRATE (N,2) = 0. endif @@ -401,7 +401,7 @@ SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & H2 = this%flood_stime + this%flood_dur if ((HC >= H1).AND.(HC < H2)) then ! use RZDEF at H1 during H1 <= HC < H2 to compute irrigrate. - if(H1 == HC) FRATE (N,crop) = RZDEF(N) /(H2 - H1)/ 3600. + if(abs(H1 - HC) < 1./3600.) FRATE (N,crop) = RZDEF(N) /(H2 - H1)/ 3600. else FRATE (N,crop) = 0. endif @@ -599,7 +599,7 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, ! The model uses rootzone soil moisture state at H1 to compute irrigation ! rates for the day and maintains the same rate through out the irrigation ! duration (H1 <= HC < H2). - if((ma <= IT).AND.(H1 == HC)) & + if((ma <= IT).AND.(abs(H1 - HC) < 1./3600.)) & SRATE = this%cwd (ROOTFRAC,SMCNT,SMREF,this%efcor)/(H2 - H1)/3600. else SRATE = 0. @@ -614,7 +614,7 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, if ((HC >= H1).AND.(HC < H2)) then ! use SMCNT at H1 during H1 <= HC < H2 to compute irrigrate. ! Notice drip uses the same soil moisture threshold of sprinkler but with 10.% efficiency correction. - if((ma <= IT).AND.(H1 == HC)) & + if((ma <= IT).AND.(abs(H1 - HC) < 1./3600.)) & DRATE = this%cwd(ROOTFRAC,SMCNT,SMREF,10.)/(H2 - H1)/3600. else DRATE = 0. @@ -631,7 +631,7 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, ! Notice Furrow irrigation uses the same soil moisture threshold of sprinkler but with ! the efficiency correction increased by 15 (e.g., Field application efficiency Sprinkler 75%, Surface Irrigation 60%. ! Source FAO) - if((ma <= IT).AND.(H1 == HC)) & + if((ma <= IT).AND.(abs(H1 - HC) < 1./3600.)) & FRATE = this%cwd (ROOTFRAC,SMCNT,SMREF,this%efcor+15.)/(H2 - H1)/3600. else FRATE = 0. From edf8419f232321510629a0f6460d4982bd87a6bf Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 16:49:48 -0400 Subject: [PATCH 51/55] irrigation: clean up werror; rename PLS_IN --> PLS_SPR for clarity (GEOS_CatchGridComp.F90, GEOS_CatchCNCLM40GridComp.F90) --- .../GEOS_CatchCNCLM40GridComp.F90 | 45 ++++++++++--------- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 44 +++++++++--------- 2 files changed, 45 insertions(+), 44 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index a83139999..089e2dce6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -4829,7 +4829,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: UUU, RHO real,pointer,dimension(:) :: LAI0,GRN0,ZVG real,pointer,dimension(:) :: Z0, D0 - real,pointer,dimension(:) :: sfmc, rzmc, prmc, werror, entot, wtot + real,pointer,dimension(:) :: sfmc, rzmc, prmc, entot, wtot real,pointer,dimension(:) :: ghflxsno, ghflxtskin real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW @@ -4842,7 +4842,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: fveg1, fveg2 real,pointer,dimension(:) :: FICE1TMP real,pointer,dimension(:) :: SLDTOT - real,pointer,dimension(:) :: PLS_IN + real,pointer,dimension(:) :: PLS_SPR ! real*8,pointer,dimension(:) :: fsum real,pointer,dimension(:,:) :: ghtcnt @@ -4919,7 +4919,7 @@ subroutine Driver ( RC ) integer :: NTILES integer :: I, J, K, N - real, dimension(:), allocatable :: AR4 ! for catch_calc_soil_moist() after irrigation application + real, dimension(:), allocatable :: AR4, werror ! for catch_calc_soil_moist() after irrigation application ! dummy variables for call to get snow temp @@ -5628,7 +5628,6 @@ subroutine Driver ( RC ) allocate(SFMC (NTILES)) allocate(RZMC (NTILES)) allocate(PRMC (NTILES)) - allocate(werror (NTILES)) allocate(ENTOT (NTILES)) allocate(ghflxsno (NTILES)) allocate(ghflxtskin(NTILES)) @@ -5691,7 +5690,7 @@ subroutine Driver ( RC ) allocate(QA1_0 (NTILES)) allocate(QA2_0 (NTILES)) allocate(QA4_0 (NTILES)) - allocate(PLS_IN (NTILES)) + allocate(PLS_SPR (NTILES)) call ESMF_VMGetCurrent ( VM, RC=STATUS ) @@ -6973,7 +6972,7 @@ subroutine Driver ( RC ) ! gkw: end of main CN block - PLS_IN = PLS ! PLS_IN = large-scale precip plus sprinkler irrigation (if present, see below) + PLS_SPR = PLS ! PLS_SPR = large-scale precip plus sprinkler irrigation (if present, see below) ! -------------------------------------------------------------------------- ! Add irrigation model imports @@ -6982,16 +6981,16 @@ subroutine Driver ( RC ) IF ((CATCHCN_INTERNAL%RUN_IRRIG /= 0)) THEN where (IRRG_RATE_SPR > 0) - PLS_IN = PLS_IN + IRRG_RATE_SPR + PLS_SPR = PLS_SPR + IRRG_RATE_SPR end where where (IRRG_RATE_DRP > 0) - RZEXC = RZEXC + IRRG_RATE_DRP * DT + RZEXC = RZEXC + IRRG_RATE_DRP * DT end where where (IRRG_RATE_FRW > 0) - RZEXC = RZEXC + IRRG_RATE_FRW * DT + RZEXC = RZEXC + IRRG_RATE_FRW * DT end where where (IRRG_RATE_PDY > 0) - SRFEXC = SRFEXC + IRRG_RATE_PDY * DT + SRFEXC = SRFEXC + IRRG_RATE_PDY * DT end where ! after application of irrigation water, make sure soil moisture prognostics @@ -6999,17 +6998,19 @@ subroutine Driver ( RC ) ! werror accounts for excess irrigation that cannot be absorbed by the soil; ! sfmc, rzmc, prmc here are dummies that are required to get werror - allocate(ar4(NTILES)) - + allocate(ar4( NTILES)) + allocate(werror(NTILES)) + call catch_calc_soil_moist( & NTILES, dzsf_in_mm, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & srfexc, rzexc, catdef, ar1, ar2, ar4, & sfmc, rzmc, prmc, werror ) - deallocate(ar4) - SPIRRG = -werror / DT ! add excess irrigation into spurious term + + deallocate(ar4) + deallocate(werror) ENDIF @@ -7031,12 +7032,12 @@ subroutine Driver ( RC ) ! Inputs - call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, PLS_IN, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, UUU, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PLS_SPR, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, UUU, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, EVSBT (:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, DEVSBT(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) @@ -7200,7 +7201,7 @@ subroutine Driver ( RC ) call CATCHCN ( NTILES, LONS, LATS, DT,catchcn_internal%USE_FWET_FOR_RUNOFF, & ! LONS, LATS are in [radians] !!! catchcn_internal%FWETC, catchcn_internal%FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF_IN_MM ,& - PCU , PLS_IN , SNO, ICE, FRZR ,& + PCU , PLS_SPR, SNO, ICE, FRZR ,& UUU ,& EVSBT(:,FSAT), DEVSBT(:,FSAT), DEDTC(:,FSAT) ,& @@ -7753,7 +7754,7 @@ subroutine Driver ( RC ) deallocate( ht ) deallocate( tp ) deallocate( soilice ) - deallocate (PLS_IN) + deallocate (PLS_SPR ) call MAPL_TimerOff ( MAPL, "-CATCHCNCLM40" ) RETURN_(ESMF_SUCCESS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 5480e567a..6c20efc44 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -4363,7 +4363,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: UUU, RHO real,pointer,dimension(:) :: LAI0,GRN0,ZVG real,pointer,dimension(:) :: Z0, D0 - real,pointer,dimension(:) :: sfmc, rzmc, prmc, werror, entot, wtot + real,pointer,dimension(:) :: sfmc, rzmc, prmc, entot, wtot real,pointer,dimension(:) :: ghflxsno, ghflxtskin real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW @@ -4374,8 +4374,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: ALWX, BLWX real,pointer,dimension(:) :: FICE1TMP real,pointer,dimension(:) :: SLDTOT - - real,pointer,dimension(:) :: PLS_IN + real,pointer,dimension(:) :: PLS_SPR ! real*8,pointer,dimension(:) :: fsum @@ -4451,7 +4450,7 @@ subroutine Driver ( RC ) integer :: NTILES integer :: I, N - real, dimension(:), allocatable :: AR4 ! for catch_calc_soil_moist() after irrigation application + real, dimension(:), allocatable :: AR4, werror ! for catch_calc_soil_moist() after irrigation application ! dummy variables for call to get snow temp @@ -4945,7 +4944,6 @@ subroutine Driver ( RC ) allocate(SFMC (NTILES)) allocate(RZMC (NTILES)) allocate(PRMC (NTILES)) - allocate(werror (NTILES)) allocate(ENTOT (NTILES)) allocate(ghflxsno (NTILES)) allocate(ghflxtskin(NTILES)) @@ -5007,7 +5005,7 @@ subroutine Driver ( RC ) allocate(RCONSTIT (NTILES,N_SNOW,N_constit)) allocate(TOTDEPOS (NTILES,N_constit)) allocate(RMELT (NTILES,N_constit)) - allocate(PLS_IN (NTILES)) + allocate(PLS_SPR (NTILES)) debugzth = .false. ! -------------------------------------------------------------------------- @@ -5613,7 +5611,7 @@ subroutine Driver ( RC ) TILEZERO = 0.0 - PLS_IN = PLS ! PLS_IN = large-scale precip plus sprinkler irrigation (if present, see below) + PLS_SPR = PLS ! PLS_SPR = large-scale precip plus sprinkler irrigation (if present, see below) ! -------------------------------------------------------------------------- ! Add irrigation model imports @@ -5622,16 +5620,16 @@ subroutine Driver ( RC ) if(CATCH_INTERNAL_STATE%RUN_IRRIG /= 0) then where (IRRG_RATE_SPR > 0) - PLS_IN = PLS_IN + IRRG_RATE_SPR + PLS_SPR = PLS_SPR + IRRG_RATE_SPR end where where (IRRG_RATE_DRP > 0) - RZEXC = RZEXC + IRRG_RATE_DRP * DT + RZEXC = RZEXC + IRRG_RATE_DRP * DT end where where (IRRG_RATE_FRW > 0) - RZEXC = RZEXC + IRRG_RATE_FRW * DT + RZEXC = RZEXC + IRRG_RATE_FRW * DT end where where (IRRG_RATE_PDY > 0) - SRFEXC = SRFEXC + IRRG_RATE_PDY * DT + SRFEXC = SRFEXC + IRRG_RATE_PDY * DT end where ! after application of irrigation water, make sure soil moisture prognostics @@ -5639,7 +5637,8 @@ subroutine Driver ( RC ) ! werror accounts for excess irrigation that cannot be absorbed by the soil; ! sfmc, rzmc, prmc here are dummies that are required to get werror - allocate(ar4(NTILES)) + allocate(ar4( NTILES)) + allocate(werror(NTILES)) call catch_calc_soil_moist( & NTILES, dzsf_in_mm, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & @@ -5647,10 +5646,11 @@ subroutine Driver ( RC ) srfexc, rzexc, catdef, ar1, ar2, ar4, & sfmc, rzmc, prmc, werror ) - deallocate(ar4) - SPIRRG = -werror / DT ! add excess irrigation into spurious term + deallocate(ar4) + deallocate(werror) + endif call MAPL_TimerOn ( MAPL, "-CATCH" ) @@ -5671,12 +5671,12 @@ subroutine Driver ( RC ) unit = unit_i ! Inputs - call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, PLS_IN, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, UUU, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PLS_SPR, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, UUU, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, EVSBT (:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, DEVSBT(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) @@ -6087,7 +6087,7 @@ subroutine Driver ( RC ) DT,CATCH_INTERNAL_STATE%USE_FWET_FOR_RUNOFF ,& CATCH_INTERNAL_STATE%FWETC, CATCH_INTERNAL_STATE%FWETL,& cat_id, VEG, DZSF_in_mm ,& ! cat_id is set to no-data above !!! - PCU , PLS_IN , SNO, ICE, FRZR ,& + PCU , PLS_SPR , SNO, ICE, FRZR ,& UUU ,& EVSBT(:,FSAT), DEVSBT(:,FSAT), DEDTC(:,FSAT) ,& @@ -6603,7 +6603,7 @@ subroutine Driver ( RC ) deallocate(RMELT ) deallocate(FICE1TMP ) deallocate(SLDTOT ) - deallocate(PLS_IN) + deallocate(PLS_SPR ) deallocate(FSW_CHANGE) RETURN_(ESMF_SUCCESS) From 09f87e9963a741359f93b8f809489b560ed177d4 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 16:56:09 -0400 Subject: [PATCH 52/55] remove obsolete local variable RUN_IRRIG (GEOS_CatchCNCLM40GridComp.F90) --- .../GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 089e2dce6..07ae5ad2d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -198,7 +198,7 @@ subroutine SetServices ( GC, RC ) ! Local Variables type(MAPL_MetaComp), pointer :: MAPL=>null() - integer :: OFFLINE_MODE, RUN_IRRIG, ATM_CO2, PRESCRIBE_DVG, N_CONST_LAND4SNWALB + integer :: OFFLINE_MODE, ATM_CO2, PRESCRIBE_DVG, N_CONST_LAND4SNWALB integer :: RESTART, SNOW_ALBEDO_INFO ! Begin... @@ -219,7 +219,6 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource ( MAPL, OFFLINE_MODE, Label="CATCHMENT_OFFLINE:", DEFAULT=0, _RC) call MAPL_GetResource ( MAPL, ATM_CO2, Label="ATM_CO2:", _RC) call MAPL_GetResource ( MAPL, N_CONST_LAND4SNWALB, Label="N_CONST_LAND4SNWALB:", _RC) - call MAPL_GetResource ( MAPL, RUN_IRRIG, Label="RUN_IRRIG:", _RC) call MAPL_GetResource ( MAPL, PRESCRIBE_DVG, Label="PRESCRIBE_DVG:", _RC) call MAPL_GetResource ( MAPL, SNOW_ALBEDO_INFO, Label="SNOW_ALBEDO_INFO:", _RC) From 340c8a3475a8c62736b33840668e1c144f776152 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 17:38:40 -0400 Subject: [PATCH 53/55] replaced EXIT() with _ASSERT() (irrigation_model.F90) --- .../GEOSirrigation_GridComp/irrigation_model.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index acac25182..7fb9e65cb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -309,8 +309,7 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, CASE DEFAULT - PRINT *, 'irrigrate_lai_trigger: IRRG_METHOD can be 0,1,2, or3' - CALL EXIT(1) + _ASSERT( .FALSE., 'irrigrate_lai_trigger(): IRRG_METHOD can only be 0, 1, 2, or 3') END SELECT endif From ee9ecba2f13ab84531aa1dcce89ded3ffb23b8b6 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Jul 2025 17:39:31 -0400 Subject: [PATCH 54/55] _ASSERT() allowable values of IRRG_TRIGGER and IRRG_METHOD (GEOS_IrrigationGridComp.F90) --- .../GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 index 68ff11537..ef953a7ab 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/GEOS_IrrigationGridComp.F90 @@ -141,6 +141,9 @@ subroutine SetServices ( GC, RC ) if(RUN_IRRIG == 0) then RETURN_(ESMF_SUCCESS) endif + + _ASSERT( 0 <= IRRG_TRIGGER .and. IRRG_TRIGGER <= 1, Iam // ' bad value for IRRG_TRIGGER' ) + _ASSERT( 0 <= IRRG_METHOD .and. IRRG_METHOD <= 3, Iam // ' bad value for IRRG_METHOD' ) ! ----------------------------------------------------------- ! Set the the Initialize and Run entry point From d27718a440198a19eaf5dade76299cbf42f123d6 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Aug 2025 17:20:15 -0400 Subject: [PATCH 55/55] fixed/added _ASSERT statements (irrigation_model.F90) --- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 2 +- .../irrigation_model.F90 | 113 ++++++++++++------ 2 files changed, 80 insertions(+), 35 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 6c20efc44..92c620a59 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -6638,7 +6638,7 @@ subroutine RUN0(gc, import, export, clock, rc) !! ESMF/MAPL variables type(MAPL_MetaComp), pointer :: MAPL - type(ESMF_State) :: INTERNAL + type(ESMF_State) :: INTERNAL !! IMPORT pointers real, pointer :: ity(:)=>null() diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 index 7fb9e65cb..f7fd51517 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSirrigation_GridComp/irrigation_model.F90 @@ -187,10 +187,13 @@ MODULE IRRIGATION_MODULE SUBROUTINE init_model (IP, SURFRC) implicit none + class (irrigation_model), intent(inout) :: IP + CHARACTER(*), INTENT(IN) :: SURFRC + type(irrig_params) :: DP - CHARACTER(*), INTENT(IN) :: SURFRC type(ESMF_Config) :: SCF + integer :: status, RC character(len=ESMF_MAXSTR) :: Iam @@ -229,18 +232,33 @@ SUBROUTINE irrigrate_lai_trigger (this,IRRG_METHOD, local_hour, SRATE, DRATE, FRATE) implicit none - class (irrigation_model), intent(inout) :: this - integer, intent (in) :: IRRG_METHOD - real, dimension (:), intent (in) :: local_hour - real, dimension (:), intent (in) :: IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_IRRIGFRAC_SPR, & - IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, SMWP, SMSAT, SMREF, SMCNT, LAI, IRRG_LAIMIN, IRRG_LAIMAX, RZDEF - real, dimension (:), intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY - real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE - INTEGER :: NTILES, N, crop - REAL :: ma, H1, H2, HC, IT, ROOTFRAC, LAITHRES - logical :: season_end + + class (irrigation_model), intent(inout) :: this + + integer, intent (in) :: IRRG_METHOD + + real, dimension (:), intent (in) :: local_hour + real, dimension (:), intent (in) :: IRRG_IRRIGFRAC, IRRG_PADDYFRAC, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW + real, dimension (:), intent (in) :: SMWP, SMSAT, SMREF, SMCNT, LAI, IRRG_LAIMIN, IRRG_LAIMAX, RZDEF + + real, dimension (:), intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY + real, dimension (:,:), intent (inout) :: SRATE, DRATE, FRATE + + ! local variables + + INTEGER :: NTILES, N, crop + REAL :: ma, H1, H2, HC, IT, ROOTFRAC, LAITHRES + logical :: season_end + + integer :: status, RC ! required for _ASSERT macro + character(len=ESMF_MAXSTR) :: Iam + + ! ------------------------------------------------------ + + Iam='IRRIGATION_MODULE: irrigrate_lai_trigger' NTILES = SIZE (IRRG_IRRIGFRAC) + TILE_LOOP : DO N = 1, NTILES IF(IRRG_LAIMAX (N) > IRRG_LAIMIN (N)) THEN LAITHRES = IRRG_LAIMIN (N) + this%lai_thres * (IRRG_LAIMAX (N) - IRRG_LAIMIN (N)) @@ -358,28 +376,40 @@ END SUBROUTINE irrigrate_lai_trigger ! ---------------------------------------------------------------------------- - SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & + SUBROUTINE irrigrate_crop_calendar(this,dofyr,local_hour, & IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW, & - IRRG_CROPIRRIGFRAC,IRRG_DOY_PLANT, IRRG_DOY_HARVEST, IRRG_TYPE , & - SMWP,SMSAT,SMREF,SMCNT, RZDEF, & + IRRG_CROPIRRIGFRAC,IRRG_DOY_PLANT, IRRG_DOY_HARVEST, IRRG_TYPE , & + SMWP,SMSAT,SMREF,SMCNT, RZDEF, & IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY, SRATE, DRATE, FRATE) implicit none - class(irrigation_model),intent(inout):: this - integer, intent (in) :: dofyr - real, dimension (:), intent (in) :: local_hour, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW - real, dimension (:), intent (in) :: SMWP, SMSAT, SMREF, SMCNT, RZDEF - real, dimension(:,:), intent (in) :: IRRG_CROPIRRIGFRAC ! IRRG_NCROPS - real, dimension(:,:), intent (in) :: IRRG_TYPE ! IRRG_NCROPS - real, dimension(:,:,:),intent (in) :: IRRG_DOY_PLANT ! IRRG_NSEASONS, IRRG_NCROPS - real, dimension(:,:,:),intent (in) :: IRRG_DOY_HARVEST ! IRRG_NSEASONS, IRRG_NCROPS - real, dimension (:),intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY - real, dimension (:,:),intent (inout) :: SRATE, DRATE, FRATE - INTEGER :: NTILES, N, crop, sea, ITYPE, I - REAL :: ma, H1, H2, HC, IT, ROOTFRAC, void_frac - logical :: season_end (IRRG_NCROPS) + + class(irrigation_model), intent(inout) :: this + integer, intent(in) :: dofyr + real, dimension(:), intent(in) :: local_hour, IRRG_IRRIGFRAC_SPR, IRRG_IRRIGFRAC_DRP, IRRG_IRRIGFRAC_FRW + real, dimension(:), intent(in) :: SMWP, SMSAT, SMREF, SMCNT, RZDEF + real, dimension(:,:), intent(in) :: IRRG_CROPIRRIGFRAC ! IRRG_NCROPS + real, dimension(:,:), intent(in) :: IRRG_TYPE ! IRRG_NCROPS + real, dimension(:,:,:), intent(in) :: IRRG_DOY_PLANT ! IRRG_NSEASONS, IRRG_NCROPS + real, dimension(:,:,:), intent(in) :: IRRG_DOY_HARVEST ! IRRG_NSEASONS, IRRG_NCROPS + real, dimension(:), intent(inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY + real, dimension(:,:), intent(inout) :: SRATE, DRATE, FRATE + + ! local variables + + INTEGER :: NTILES, N, crop, sea, ITYPE, I + REAL :: ma, H1, H2, HC, IT, ROOTFRAC, void_frac + logical :: season_end (IRRG_NCROPS) + + integer :: status, RC ! required for _ASSERT macro + character(len=ESMF_MAXSTR) :: Iam + + ! ---------------------------------------------------------- + + Iam='IRRIGATION_MODULE: irrigrate_crop_calendar' + NTILES = SIZE (local_hour) - + TILE_LOOP : DO N = 1, NTILES HC = local_hour(n) IF_IRR: if(SUM(IRRG_CROPIRRIGFRAC(N,:)) > 0.) then @@ -516,8 +546,15 @@ SUBROUTINE update_irates_lai (this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_FRW,IRR real, dimension(:,:), intent(in) :: SRATE, DRATE, FRATE real, dimension(:), intent(inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY - integer :: N, NT + ! local variables + + integer :: N, NT + integer :: status, RC ! required for _ASSERT macro + character(len=ESMF_MAXSTR) :: Iam + + Iam='IRRIGATION_MODULE: update_irates_lai' + ! INITIALIZE EXPORTS IRRG_RATE_SPR = 0. IRRG_RATE_DRP = 0. @@ -526,7 +563,7 @@ SUBROUTINE update_irates_lai (this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_FRW,IRR NT = size (IRRG_IRRIGFRAC) - !_ASSERT(size (SRATE,2)==IRRG_NCROPS,'Irrigation model LAI trigger irrig tile types mismatch') + _ASSERT( size(SRATE,2)==IRRG_NCROPS, 'SRATE dimension mismatch') DO N = 1, NT IF ((IRRG_IRRIGFRAC(N) + IRRG_PADDYFRAC(N)) > 0.) THEN @@ -552,15 +589,23 @@ SUBROUTINE update_irates_ccalendar(this,IRRG_RATE_SPR,IRRG_RATE_DRP,IRRG_RATE_FR real, dimension(:,:), intent (in) :: SRATE, DRATE, FRATE real, dimension(:), intent (inout) :: IRRG_RATE_SPR, IRRG_RATE_DRP, IRRG_RATE_FRW, IRRG_RATE_PDY - integer :: N, NT, crop + ! local variables + + integer :: N, NT, crop + + integer :: status, RC ! required for _ASSERT macro + character(len=ESMF_MAXSTR) :: Iam + Iam='IRRIGATION_MODULE: update_irates_ccalendar' + ! INITIALIZE EXPORTS IRRG_RATE_SPR = 0. IRRG_RATE_DRP = 0. IRRG_RATE_FRW = 0. IRRG_RATE_PDY = 0. - !_ASSERT(size (SRATE,2)==IRRG_NCROPS,'Irrigation model crop calendar trigger IRRG_NCROPS mismatch') + _ASSERT( size (SRATE,2)==IRRG_NCROPS, 'SRATE dimension mismatch') + NT = size (IRRG_RATE_SPR) DO N = 1, NT if(SUM(IRRG_CROPIRRIGFRAC(N,:)) > 0.) then @@ -585,8 +630,8 @@ SUBROUTINE irrig_by_method (this, HC, ma, ROOTFRAC, SMCNT, SMREF, SRATE, DRATE, implicit none class (irrigation_model), intent(inout) :: this - REAL, intent (in) :: HC, ma, ROOTFRAC,SMCNT, SMREF - REAL, optional, intent (inout) :: SRATE, DRATE, FRATE + REAL, intent(in) :: HC, ma, ROOTFRAC,SMCNT, SMREF + REAL, optional, intent(inout) :: SRATE, DRATE, FRATE REAL :: H1, H2, IT if(present (SRATE)) then