diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 index 6ca7faed9..45163f1b1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 @@ -711,11 +711,6 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real :: bgstressmax real, pointer, dimension(:,:) :: LATS - character(len=ESMF_MAXSTR) :: GRIDNAME - character(len=4) :: imchar - character(len=2) :: dateline - integer :: imsize,nn - ! Rayleigh friction parameters REAL :: H0, HH, Z1, TAU1 @@ -752,16 +747,6 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) RC=STATUS ) VERIFY_(STATUS) -! Get grid name to determine IMSIZE - call MAPL_GetResource(MAPL,GRIDNAME,'AGCM_GRIDNAME:', RC=STATUS) - VERIFY_(STATUS) - GRIDNAME = AdjustL(GRIDNAME) - nn = len_trim(GRIDNAME) - dateline = GRIDNAME(nn-1:nn) - imchar = GRIDNAME(3:index(GRIDNAME,'x')-1) - read(imchar,*) imsize - if(dateline.eq.'CF') imsize = imsize*4 - ! Gravity wave drag ! ----------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 9b111edcf..4867650d6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -98,6 +98,7 @@ module GEOS_SurfaceGridCompMod integer :: DO_OBIO, ATM_CO2 integer :: CHOOSEMOSFC logical :: DO_GOSWIM + logical :: DO_FIRE_DANGER ! used only when DO_OBIO==1 or ATM_CO2 == ATM_CO2_FOUR integer, parameter :: NB_CHOU_UV = 5 ! Number of UV bands @@ -243,6 +244,7 @@ subroutine SetServices ( GC, RC ) _ASSERT(.FALSE.,'unknown LSM_CHOICE') end if call MAPL_GetResource (SCF, CHOOSEMOSFC, label='CHOOSEMOSFC:', DEFAULT=1, __RC__ ) + call MAPL_GetResource (SCF, DO_FIRE_DANGER,label='FIRE_DANGER:', DEFAULT=.false., __RC__ ) call ESMF_ConfigDestroy(SCF, __RC__ ) @@ -2952,6 +2954,178 @@ subroutine SetServices ( GC, RC ) END IF + + if (DO_FIRE_DANGER) then + + ! hourly + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FFMC', & + LONG_NAME = 'fine fuel moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'GFMC', & + LONG_NAME = 'grass fuel moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DMC', & + LONG_NAME = 'duff moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DC', & + LONG_NAME = 'drought code', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FWI', & + LONG_NAME = 'fire weather index', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'BUI', & + LONG_NAME = 'buildup index', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ISI', & + LONG_NAME = 'initial spread index', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DSR', & + LONG_NAME = 'daily severity rating', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + ! daily + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FFMC_DAILY', & + LONG_NAME = 'fine fuel moisture code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DMC_DAILY', & + LONG_NAME = 'duff moisture code (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DC_DAILY', & + LONG_NAME = 'drought code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FWI_DAILY', & + LONG_NAME = 'fire weather index (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'BUI_DAILY', & + LONG_NAME = 'buildup index (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ISI_DAILY', & + LONG_NAME = 'initial spread index (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DSR_DAILY', & + LONG_NAME = 'daily severity rating (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FFMC_DAILY_', & + LONG_NAME = 'fine fuel moisture code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DMC_DAILY_', & + LONG_NAME = 'duff moisture code (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DC_DAILY_', & + LONG_NAME = 'drought code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FWI_DAILY_', & + LONG_NAME = 'fire weather index (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'BUI_DAILY_', & + LONG_NAME = 'buildup index (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ISI_DAILY_', & + LONG_NAME = 'initial spread index (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DSR_DAILY_', & + LONG_NAME = 'daily severity rating (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + ! flammability and ignition sources + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'VPD', & + LONG_NAME = 'vapor pressure deficit', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + end if + + ! !INTERNAL STATE: ! These are here only because they are passed between run1 and run2. @@ -5152,6 +5326,34 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: SIF => NULL() real, pointer, dimension(:,:) :: CNFSEL => NULL() +! Fire danger + real, pointer, dimension(:,:) :: FFMC => NULL() + real, pointer, dimension(:,:) :: GFMC => NULL() + real, pointer, dimension(:,:) :: DMC => NULL() + real, pointer, dimension(:,:) :: DC => NULL() + real, pointer, dimension(:,:) :: ISI => NULL() + real, pointer, dimension(:,:) :: BUI => NULL() + real, pointer, dimension(:,:) :: FWI => NULL() + real, pointer, dimension(:,:) :: DSR => NULL() + + real, pointer, dimension(:,:) :: FFMC_DAILY => NULL() + real, pointer, dimension(:,:) :: DMC_DAILY => NULL() + real, pointer, dimension(:,:) :: DC_DAILY => NULL() + real, pointer, dimension(:,:) :: ISI_DAILY => NULL() + real, pointer, dimension(:,:) :: BUI_DAILY => NULL() + real, pointer, dimension(:,:) :: FWI_DAILY => NULL() + real, pointer, dimension(:,:) :: DSR_DAILY => NULL() + + real, pointer, dimension(:,:) :: FFMC_DAILY_ => NULL() + real, pointer, dimension(:,:) :: DMC_DAILY_ => NULL() + real, pointer, dimension(:,:) :: DC_DAILY_ => NULL() + real, pointer, dimension(:,:) :: ISI_DAILY_ => NULL() + real, pointer, dimension(:,:) :: BUI_DAILY_ => NULL() + real, pointer, dimension(:,:) :: FWI_DAILY_ => NULL() + real, pointer, dimension(:,:) :: DSR_DAILY_ => NULL() + + real, pointer, dimension(:,:) :: VPD => NULL() + ! These are the tile versions of the imports real, pointer, dimension(:) :: PSTILE => NULL() @@ -5415,6 +5617,35 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:) :: SLITILE => NULL() real, pointer, dimension(:) :: ZTHTILE => NULL() +! Fire danger + real, pointer, dimension(:) :: FFMCTILE => NULL() + real, pointer, dimension(:) :: GFMCTILE => NULL() + real, pointer, dimension(:) :: DMCTILE => NULL() + real, pointer, dimension(:) :: DCTILE => NULL() + real, pointer, dimension(:) :: ISITILE => NULL() + real, pointer, dimension(:) :: BUITILE => NULL() + real, pointer, dimension(:) :: FWITILE => NULL() + real, pointer, dimension(:) :: DSRTILE => NULL() + + real, pointer, dimension(:) :: FFMCDAILYTILE => NULL() + real, pointer, dimension(:) :: DMCDAILYTILE => NULL() + real, pointer, dimension(:) :: DCDAILYTILE => NULL() + real, pointer, dimension(:) :: ISIDAILYTILE => NULL() + real, pointer, dimension(:) :: BUIDAILYTILE => NULL() + real, pointer, dimension(:) :: FWIDAILYTILE => NULL() + real, pointer, dimension(:) :: DSRDAILYTILE => NULL() + + real, pointer, dimension(:) :: FFMCDAILYTILE_ => NULL() + real, pointer, dimension(:) :: DMCDAILYTILE_ => NULL() + real, pointer, dimension(:) :: DCDAILYTILE_ => NULL() + real, pointer, dimension(:) :: ISIDAILYTILE_ => NULL() + real, pointer, dimension(:) :: BUIDAILYTILE_ => NULL() + real, pointer, dimension(:) :: FWIDAILYTILE_ => NULL() + real, pointer, dimension(:) :: DSRDAILYTILE_ => NULL() + + real, pointer, dimension(:) :: VPDTILE => NULL() + + real, pointer, dimension(:,:) :: TMP => NULL() real, pointer, dimension(:,:) :: TTM => NULL() real, pointer, dimension(:,:) :: QTM => NULL() @@ -6253,6 +6484,35 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , CNFSEL , 'CNFSEL' , RC=STATUS); VERIFY_(STATUS) END IF + if (DO_FIRE_DANGER) then + call MAPL_GetPointer(EXPORT , FFMC , 'FFMC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , GFMC , 'GFMC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DMC , 'DMC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DC , 'DC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , FWI , 'FWI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , BUI , 'BUI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , ISI , 'ISI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DSR , 'DSR' , RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(EXPORT , FFMC_DAILY , 'FFMC_DAILY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DMC_DAILY , 'DMC_DAILY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DC_DAILY , 'DC_DAILY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , FWI_DAILY , 'FWI_DAILY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , BUI_DAILY , 'BUI_DAILY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , ISI_DAILY , 'ISI_DAILY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DSR_DAILY , 'DSR_DAILY' , RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(EXPORT , FFMC_DAILY_ , 'FFMC_DAILY_', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DMC_DAILY_ , 'DMC_DAILY_' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DC_DAILY_ , 'DC_DAILY_' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , FWI_DAILY_ , 'FWI_DAILY_' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , BUI_DAILY_ , 'BUI_DAILY_' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , ISI_DAILY_ , 'ISI_DAILY_' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , DSR_DAILY_ , 'DSR_DAILY_' , RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(EXPORT , VPD , 'VPD' , RC=STATUS); VERIFY_(STATUS) + end if + ! Force allocation for ice fraction for lwi mask call MAPL_GetPointer(EXPORT , FRI , 'FRACI' , alloc=associated(LWI) , rC=STATUS) @@ -6374,7 +6634,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) ZTHTILE = max(0.0,ZTHTILE) -! We need atmsopheric version of the run1 outputs put back on tiles +! We need atmospheric version of the run1 outputs put back on tiles !------------------------------------------------------------------ allocate( TSTILE(NT), STAT=STATUS) @@ -6828,6 +7088,36 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MKTILE(CNFSEL ,CNFSELTILE ,NT,RC=STATUS); VERIFY_(STATUS) END IF + if (DO_FIRE_DANGER) then + call MKTILE(FFMC, FFMCTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(GFMC, GFMCTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DMC, DMCTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DC, DCTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(FWI, FWITILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(BUI, BUITILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(ISI, ISITILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DSR, DSRTILE, NT, RC=STATUS); VERIFY_(STATUS) + + call MKTILE(FFMC_DAILY, FFMCDAILYTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DMC_DAILY, DMCDAILYTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DC_DAILY, DCDAILYTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(FWI_DAILY, FWIDAILYTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(BUI_DAILY, BUIDAILYTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(ISI_DAILY, ISIDAILYTILE, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DSR_DAILY, DSRDAILYTILE, NT, RC=STATUS); VERIFY_(STATUS) + + call MKTILE(FFMC_DAILY_, FFMCDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DMC_DAILY_, DMCDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DC_DAILY_, DCDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(FWI_DAILY_, FWIDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(BUI_DAILY_, BUIDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(ISI_DAILY_, ISIDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + call MKTILE(DSR_DAILY_, DSRDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + + call MKTILE(VPD, VPDTILE, NT, RC=STATUS); VERIFY_(STATUS) + end if + + FRTILE = 0.0 ! Cycle through all continental children (skip ocean), @@ -7736,6 +8026,103 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) endif +! Fire danger + if (associated(FFMC)) then + call MAPL_LocStreamTransform(LOCSTREAM, FFMC, FFMCTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(GFMC)) then + call MAPL_LocStreamTransform(LOCSTREAM, GFMC, GFMCTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DMC)) then + call MAPL_LocStreamTransform(LOCSTREAM, DMC, DMCTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DC)) then + call MAPL_LocStreamTransform(LOCSTREAM, DC, DCTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(ISI)) then + call MAPL_LocStreamTransform(LOCSTREAM, ISI, ISITILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(BUI)) then + call MAPL_LocStreamTransform(LOCSTREAM, BUI, BUITILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(FWI)) then + call MAPL_LocStreamTransform(LOCSTREAM, FWI, FWITILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DSR)) then + call MAPL_LocStreamTransform(LOCSTREAM, DSR, DSRTILE, RC=STATUS) + VERIFY_(STATUS) + end if + + if (associated(FFMC_DAILY)) then + call MAPL_LocStreamTransform(LOCSTREAM, FFMC_DAILY, FFMCDAILYTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DMC_DAILY)) then + call MAPL_LocStreamTransform(LOCSTREAM, DMC_DAILY, DMCDAILYTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DC_DAILY)) then + call MAPL_LocStreamTransform(LOCSTREAM, DC_DAILY, DCDAILYTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(ISI_DAILY)) then + call MAPL_LocStreamTransform(LOCSTREAM, ISI_DAILY, ISIDAILYTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(BUI_DAILY)) then + call MAPL_LocStreamTransform(LOCSTREAM, BUI_DAILY, BUIDAILYTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(FWI_DAILY)) then + call MAPL_LocStreamTransform(LOCSTREAM, FWI_DAILY, FWIDAILYTILE, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DSR_DAILY)) then + call MAPL_LocStreamTransform(LOCSTREAM, DSR_DAILY, DSRDAILYTILE, RC=STATUS) + VERIFY_(STATUS) + end if + + if (associated(FFMC_DAILY_)) then + call MAPL_LocStreamTransform(LOCSTREAM, FFMC_DAILY_, FFMCDAILYTILE_, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DMC_DAILY_)) then + call MAPL_LocStreamTransform(LOCSTREAM, DMC_DAILY_, DMCDAILYTILE_, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DC_DAILY_)) then + call MAPL_LocStreamTransform(LOCSTREAM, DC_DAILY_, DCDAILYTILE_, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(ISI_DAILY_)) then + call MAPL_LocStreamTransform(LOCSTREAM, ISI_DAILY_, ISIDAILYTILE_, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(BUI_DAILY_)) then + call MAPL_LocStreamTransform(LOCSTREAM, BUI_DAILY_, BUIDAILYTILE_, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(FWI_DAILY_)) then + call MAPL_LocStreamTransform(LOCSTREAM, FWI_DAILY_, FWIDAILYTILE_, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DSR_DAILY_)) then + call MAPL_LocStreamTransform(LOCSTREAM, DSR_DAILY_, DSRDAILYTILE_, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(VPD)) then + call MAPL_LocStreamTransform(LOCSTREAM, VPD, VPDTILE, RC=STATUS) + VERIFY_(STATUS) + end if + + ! Fill exports computed on agcm grid !----------------------------------- @@ -8690,6 +9077,59 @@ subroutine DOTYPE(type,RC) call MAPL_GetPointer(GEX(type), dum, 'FHOCN' ,ALLOC=associated(FHOCNTILE ), notFoundOK=.true., RC=STATUS) VERIFY_(STATUS) + if (DO_FIRE_DANGER) then + call MAPL_GetPointer(GEX(type), dum, 'FFMC', ALLOC=associated(FFMCTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'GFMC', ALLOC=associated(GFMCTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DMC', ALLOC=associated(DMCTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DC', ALLOC=associated(DCTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'ISI', ALLOC=associated(ISITILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'BUI', ALLOC=associated(BUITILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'FWI', ALLOC=associated(FWITILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DSR', ALLOC=associated(DSRTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetPointer(GEX(type), dum, 'FFMC_DAILY', ALLOC=associated(FFMCDAILYTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DMC_DAILY', ALLOC=associated(DMCDAILYTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DC_DAILY', ALLOC=associated(DCDAILYTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'ISI_DAILY', ALLOC=associated(ISIDAILYTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'BUI_DAILY', ALLOC=associated(BUIDAILYTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'FWI_DAILY', ALLOC=associated(FWIDAILYTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DSR_DAILY', ALLOC=associated(DSRDAILYTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetPointer(GEX(type), dum, 'FFMC_DAILY_', ALLOC=associated(FFMCDAILYTILE_), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DMC_DAILY_', ALLOC=associated(DMCDAILYTILE_), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DC_DAILY_', ALLOC=associated(DCDAILYTILE_), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'ISI_DAILY_', ALLOC=associated(ISIDAILYTILE_), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'BUI_DAILY_', ALLOC=associated(BUIDAILYTILE_), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'FWI_DAILY_', ALLOC=associated(FWIDAILYTILE_), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'DSR_DAILY_', ALLOC=associated(DSRDAILYTILE_), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetPointer(GEX(type), dum, 'VPD', ALLOC=associated(VPDTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + end if + + ! All children can produce these call MAPL_GetPointer(GEX(type), dum, 'DELTS' , ALLOC=associated(DTSTILE) , RC=STATUS) @@ -9470,6 +9910,103 @@ subroutine DOTYPE(type,RC) VERIFY_(STATUS) end if +! Fire danger + if (associated(FFMCTILE)) then + call FILLOUT_TILE(GEX(type), 'FFMC', FFMCTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(GFMCTILE)) then + call FILLOUT_TILE(GEX(type), 'GFMC', GFMCTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DMCTILE)) then + call FILLOUT_TILE(GEX(type), 'DMC', DMCTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DCTILE)) then + call FILLOUT_TILE(GEX(type), 'DC', DCTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(ISITILE)) then + call FILLOUT_TILE(GEX(type), 'ISI', ISITILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(BUITILE)) then + call FILLOUT_TILE(GEX(type), 'BUI', BUITILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(FWITILE)) then + call FILLOUT_TILE(GEX(type), 'FWI', FWITILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DSRTILE)) then + call FILLOUT_TILE(GEX(type), 'DSR', DSRTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + + if (associated(FFMCDAILYTILE)) then + call FILLOUT_TILE(GEX(type), 'FFMC_DAILY', FFMCDAILYTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DMCDAILYTILE)) then + call FILLOUT_TILE(GEX(type), 'DMC_DAILY', DMCDAILYTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DCDAILYTILE)) then + call FILLOUT_TILE(GEX(type), 'DC_DAILY', DCDAILYTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(ISIDAILYTILE)) then + call FILLOUT_TILE(GEX(type), 'ISI_DAILY', ISIDAILYTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(BUIDAILYTILE)) then + call FILLOUT_TILE(GEX(type), 'BUI_DAILY', BUIDAILYTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(FWIDAILYTILE)) then + call FILLOUT_TILE(GEX(type), 'FWI_DAILY', FWIDAILYTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DSRDAILYTILE)) then + call FILLOUT_TILE(GEX(type), 'DSR_DAILY', DSRDAILYTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + + if (associated(FFMCDAILYTILE_)) then + call FILLOUT_TILE(GEX(type), 'FFMC_DAILY_', FFMCDAILYTILE_, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DMCDAILYTILE_)) then + call FILLOUT_TILE(GEX(type), 'DMC_DAILY_', DMCDAILYTILE_, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DCDAILYTILE_)) then + call FILLOUT_TILE(GEX(type), 'DC_DAILY_', DCDAILYTILE_, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(ISIDAILYTILE_)) then + call FILLOUT_TILE(GEX(type), 'ISI_DAILY_', ISIDAILYTILE_, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(BUIDAILYTILE_)) then + call FILLOUT_TILE(GEX(type), 'BUI_DAILY_', BUIDAILYTILE_, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(FWIDAILYTILE_)) then + call FILLOUT_TILE(GEX(type), 'FWI_DAILY_', FWIDAILYTILE_, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(DSRDAILYTILE_)) then + call FILLOUT_TILE(GEX(type), 'DSR_DAILY_', DSRDAILYTILE_, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if (associated(VPDTILE)) then + call FILLOUT_TILE(GEX(type), 'VPD', VPDTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + + call MAPL_TimerOff(MAPL,"--RUN2_"//trim(GCNames(type))) call MAPL_TimerOff(MAPL, trim(GCNames(type))) 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 cf332f0fc..3870c429b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt @@ -6,6 +6,7 @@ set (alldirs GEOScatchCN_GridComp GEOSlana_GridComp GEOSroute_GridComp + GEOSigni_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 facda0ad9..1d68bb3f2 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 @@ -4,7 +4,7 @@ module GEOS_LandGridCompMod !BOP -! !MODULE: GEOS_LandGridCompMod -- A Module to combine VegDyn and Catch Gridded Components +! !MODULE: GEOS_LandGridCompMod -- A Module to combine VegDyn and Catch, and Igni Gridded Components ! !DESCRIPTION: This gridded component operates on the land tiles as ! as child of GEOS\_SurfaceGridComp. The core functionality is the @@ -30,6 +30,7 @@ module GEOS_LandGridCompMod 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 implicit none @@ -45,7 +46,9 @@ module GEOS_LandGridCompMod integer :: VEGDYN integer, allocatable :: CATCH(:), ROUTE (:), CATCHCN (:) - INTEGER :: LSM_CHOICE, RUN_ROUTE, DO_GOSWIM + integer :: LSM_CHOICE, RUN_ROUTE, DO_GOSWIM + integer :: IGNI + logical :: DO_FIRE_DANGER contains @@ -153,6 +156,7 @@ subroutine SetServices ( GC, RC ) 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, 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) @@ -204,7 +208,14 @@ subroutine SetServices ( GC, RC ) ! end do ! end if ! ENDIF - + + if (DO_FIRE_DANGER) then + IGNI = MAPL_AddChild(GC, NAME='IGNI'//trim(tmp), SS=IgniSetServices, RC=STATUS) + VERIFY_(STATUS) + else + IGNI = -1 + end if + !BOS !------------------------------------------------------------ @@ -1343,6 +1354,37 @@ 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__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DMC', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DC', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'ISI', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'BUI', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FWI', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DSR', CHILD_ID = IGNI, __RC__ ) + + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FFMC_DAILY', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DMC_DAILY', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DC_DAILY', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'ISI_DAILY', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'BUI_DAILY', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FWI_DAILY', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DSR_DAILY', CHILD_ID = IGNI, __RC__ ) + + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FFMC_DAILY_', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DMC_DAILY_', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DC_DAILY_', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'ISI_DAILY_', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'BUI_DAILY_', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FWI_DAILY_', CHILD_ID = IGNI, __RC__ ) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DSR_DAILY_', CHILD_ID = IGNI, __RC__ ) + + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'VPD', CHILD_ID = IGNI, __RC__ ) + end if + + !EOS !------------------------------------------------------------ @@ -1367,6 +1409,19 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + if (DO_FIRE_DANGER) then + call MAPL_AddConnectivity ( & + GC, & + SHORT_NAME = (/ 'MOT2M ', 'MOQ2M ', & + 'MOU10M ', 'MOV10M ', & + 'PRLAND ', 'SWDOWNLAND', & + 'ASNOW ', 'SNOWDP ' /), & + DST_ID = IGNI, & + SRC_ID = CATCH(I), & + RC = STATUS ) + VERIFY_(STATUS) + end if + ! IF(RUN_ROUTE == 1) THEN ! call MAPL_AddConnectivity ( & ! GC ,& @@ -1387,6 +1442,19 @@ subroutine SetServices ( GC, RC ) SRC_ID = VEGDYN , & RC=STATUS ) + if (DO_FIRE_DANGER) then + call MAPL_AddConnectivity ( & + GC, & + SHORT_NAME = (/ 'MOT2M ', 'MOQ2M ', & + 'MOU10M ', 'MOV10M ', & + 'PRLAND ', 'SWDOWNLAND', & + 'ASNOW ', 'SNOWDP ' /), & + DST_ID = IGNI, & + SRC_ID = CATCHCN(I), & + RC = STATUS ) + VERIFY_(STATUS) + end if + ! IF(RUN_ROUTE == 1) THEN ! call MAPL_AddConnectivity ( & ! GC ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 index ff99b4d50..3bab4f385 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 @@ -9,6 +9,11 @@ module clm_varpar ! Module containing CLM parameters ! ! !USES: + + use clm_varpar_shared, only : VAR_COL =>VAR_COL_40, VAR_PFT => VAR_PFT_40, & + numpft => numpft_CN, NUM_ZON => NUM_ZON_CN, & + NUM_VEG => NUM_VEG_CN + ! ! !PUBLIC TYPES: implicit none @@ -23,7 +28,6 @@ module clm_varpar ! Define indices used in surface file read ! maxpatch_pft = max number of plant functional types in naturally vegetated landunit - integer, parameter :: numpft = 19 ! actual # of pfts (without bare) integer :: maxpatch_pft ! clm_varpar_init seems to do something similar; less prone to error to move @@ -39,10 +43,6 @@ module clm_varpar ! CatchCN parameters ! ------------------ - integer, parameter, PUBLIC :: NUM_ZON=3 ! number of CN hydrology zones per tile - integer, parameter, PUBLIC :: NUM_VEG=4 ! number of CN PFTs per zone - integer, parameter, PUBLIC :: VAR_COL=40 ! number of CN column restart variables - integer, parameter, PUBLIC :: VAR_PFT=74 ! number of CN PFT variables per column real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 integer, parameter, PUBLIC :: map_cat(0:numpft) = (/4,3,3,3,1,1,2,2,2,5,5,5,6,4,4,4,4,4,4,4/) ! gkw: 0 -> 6, since 8 now gone 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 2c290094f..d9596569e 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 @@ -5167,13 +5167,10 @@ subroutine Driver ( RC ) ! Variables for FPAR ! -------------------------- real , allocatable, dimension (:,:) :: parzone + character(len=ESMF_MAXSTR) :: Co2_CycleFile IAm=trim(COMP_NAME)//"::RUN2::Driver" - ! Begin - - IAm=trim(COMP_NAME)//"Driver" - ! -------------------------------------------------------------------------- ! Get time step from configuration ! -------------------------------------------------------------------------- @@ -5656,7 +5653,11 @@ subroutine Driver ( RC ) call MPI_Info_create(info, STATUS); VERIFY_(status) call MPI_Info_set(info, "romio_cb_read", "automatic", STATUS); VERIFY_(status) - STATUS = NF_OPEN ('CO2_MonthlyMean_DiurnalCycle.nc4', NF_NOWRITE, CTfile); VERIFY_(status) + call MAPL_GetResource (MAPL, CO2_CycleFile, label = 'CO2_MonthlyMean_DiurnalCycle_FILE:', & + default = 'CO2_MonthlyMean_DiurnalCycle.nc4', RC=STATUS ) + VERIFY_(STATUS) + + STATUS = NF_OPEN (trim(CO2_CycleFile), NF_NOWRITE, CTfile); VERIFY_(status) allocate (CT_CO2V (1: NUNQ, 1:12, 1:8)) allocate (CTCO2_TMP (1:CT_grid_N_lon, 1:CT_grid_N_lat, 1:12, 1:8)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 index a6c9bc66f..151eccc3a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 @@ -10,6 +10,9 @@ module clm_varpar ! ! !USES: ! + use clm_varpar_shared, only : VAR_COL =>VAR_COL_45, VAR_PFT => VAR_PFT_45, & + numpft => numpft_CN, NUM_ZON => NUM_ZON_CN, & + NUM_VEG => NUM_VEG_CN ! !PUBLIC TYPES: implicit none save @@ -26,7 +29,6 @@ module clm_varpar ! Define indices used in surface file read ! maxpatch_pft = max number of plant functional types in naturally vegetated landunit - integer, parameter :: numpft = 19 ! actual # of pfts (without bare), same as in Catchment-CN.clm4 integer :: maxpatch_pft ! clm_varpar_init seems to do something similar; less prone to error to move @@ -85,10 +87,6 @@ module clm_varpar ! 8: DESERT => 0 ! 9: ICE => n/a - integer, parameter, PUBLIC :: NUM_ZON=3 ! number of CN hydrology zones per tile - integer, parameter, PUBLIC :: NUM_VEG=4 ! number of CN PFTs per zone - integer, parameter, PUBLIC :: VAR_COL=35 ! number of CN column restart variables - integer, parameter, PUBLIC :: VAR_PFT=75 ! number of CN PFT variables per column real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 integer, parameter, PUBLIC :: map_cat(0:numpft) = (/4,3,3,3,1,1,2,2,2,5,5,5,6,4,4,4,4,4,4,4/) 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 9e380d22a..5fa098a89 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 @@ -5115,7 +5115,7 @@ subroutine Driver ( RC ) real, allocatable, dimension(:,:,:) :: pft real, allocatable, dimension(:) :: lnfm - character(len=ESMF_MAXSTR) :: LNFMFile + character(len=ESMF_MAXSTR) :: LNFMFile, CO2_CycleFile integer :: ntile, nv, dpy, ierr, iok, ndt integer, save :: year_prev = -9999 @@ -5653,7 +5653,9 @@ subroutine Driver ( RC ) call MPI_Info_create(info, STATUS); VERIFY_(status) call MPI_Info_set(info, "romio_cb_read", "automatic", STATUS); VERIFY_(status) - STATUS = NF_OPEN ('CO2_MonthlyMean_DiurnalCycle.nc4', NF_NOWRITE, CTfile); VERIFY_(status) + call MAPL_GetResource (MAPL, CO2_CycleFile, label = 'CO2_MonthlyMean_DiurnalCycle_FILE:', default = 'CO2_MonthlyMean_DiurnalCycle.nc4', RC=STATUS ) + VERIFY_(STATUS) + STATUS = NF_OPEN (trim(CO2_CycleFile), NF_NOWRITE, CTfile); VERIFY_(status) allocate (CT_CO2V (1: NUNQ, 1:12, 1:8)) allocate (CTCO2_TMP (1:CT_grid_N_lon, 1:CT_grid_N_lat, 1:12, 1:8)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt index 2fcb3c483..decc7f7e7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt @@ -3,7 +3,8 @@ esma_set_this(OVERRIDE GEOS_CatchCNShared) set (srcs nanMod.F90 catchmentCN.F90 - catchcn_iau.F90) + catchcn_iau.F90 + clm_varpar_shared.F90) esma_add_library (${this} SRCS ${srcs} diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 new file mode 100644 index 000000000..c5d39f267 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 @@ -0,0 +1,29 @@ +module clm_varpar_shared + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varpar_shared +! +! !DESCRIPTION: +! Module containing CLM parameters +! +! !USES: +! +! !PUBLIC TYPES: + implicit none + save +! +! Define number of levels + + integer, parameter :: numpft_CN = 19 ! actual # of pfts (without bare), same as in Catchment-CN.clm4 + + integer, parameter, PUBLIC :: NUM_ZON_CN=3 ! number of CN hydrology zones per tile + integer, parameter, PUBLIC :: NUM_VEG_CN=4 ! number of CN PFTs per zone + integer, parameter, PUBLIC :: VAR_COL_40=40 ! number of CN column restart variables + integer, parameter, PUBLIC :: VAR_PFT_40=74 ! number of CN PFT variables per column + integer, parameter, PUBLIC :: VAR_COL_45=35 ! number of CN column restart variables + integer, parameter, PUBLIC :: VAR_PFT_45=75 ! number of CN PFT variables per column + +!------------------------------------------------------------------------------ +end module clm_varpar_shared diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/CMakeLists.txt new file mode 100644 index 000000000..24dc74d30 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/CMakeLists.txt @@ -0,0 +1,22 @@ +esma_set_this () + + +set (resource_files + GEOS_IgniGridComp.rc + ) + +install( FILES ${resource_files} + DESTINATION etc + ) + +set (srcs + GEOS_IgniGridComp.F90 + cffwi.F90 + ) + + +esma_add_library (${this} + SRCS ${srcs} + DEPENDENCIES MAPL GEOS_Shared esmf + ) + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 new file mode 100644 index 000000000..e41e20a46 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 @@ -0,0 +1,1550 @@ +#include "MAPL_Generic.h" + + +!============================================================================= +module GEOS_IgniGridCompMod + +!BOP + +! !MODULE: GEOS_Igni -- Implements fire weather and fire danger. + +!DESCRIPTION: +! {\tt GEOS\_Igni} is a gridded component that integrates fire weather +! observations into fuel moisture codes and fire behavior indexes +! based on the Canadian FWI System. \\ +! +! {\tt GEOS\_Igni} includes hourly and daily variants of the FWI system that +! predict Fine Fuel Moisture Code (FFMC), Duff Moisture Code (DMC), +! Drought Code (DC), Initial Spread Index (ISI), Buildup Index (BUI), +! Fire Weather Index (FWI) and Daily Severity Rating (DSR). These are +! calculated on the land tiles. \\ +! + +! !USES: + + use ESMF + use MAPL + + use GEOS_UtilsMod, only: GEOS_QSAT + + use cffwi, only: fine_fuel_moisture_code, & + grass_fuel_moisture_code, & + duff_moisture_code, & + drought_code, & + initial_spread_index, & + buildup_index, & + fire_weather_index, & + daily_severity_rating, & + FFMC_INIT, DMC_INIT, DC_INIT, & + NOMINAL_FINE_FUEL_LOAD + + implicit none + private + +! !PUBLIC MEMBER FUNCTIONS: + + public SetServices + + +! ! Private state + + integer :: NUM_ENSEMBLE + + integer, parameter :: LOCAL_NOON_SOLAR = 0 + integer, parameter :: LOCAL_NOON_LST = 1 + + type IGNI_State + private + integer :: local_noon_method = LOCAL_NOON_SOLAR + end type IGNI_State + + type wrap_ + type (IGNI_State), pointer :: PTR => null() + end type wrap_ + + +!EOP + +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 (IGNI_State), pointer :: self + type (wrap_) :: wrap + + +! Local + + real :: run_dt + real :: dt + + character(len=ESMF_MAXSTR) :: resource_file + type(ESMF_Config) :: config + character(len=ESMF_MAXSTR) :: local_noon + + +!============================================================================= + +! Begin... + +!------------------------------------------------------------ +! Get my name and set-up traceback handle +!------------------------------------------------------------ + + call ESMF_GridCompGet(GC, NAME=COMP_NAME, __RC__) + + Iam = trim(COMP_NAME) // 'SetServices' + + +! ----------------------------------------------------------- +! Wrap private internal state for storing in GC +! ----------------------------------------------------------- + allocate (self, __STAT__) + wrap%ptr => self + +! ----------------------------------------------------------- +! Set the Run entry point +! ----------------------------------------------------------- + + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_RUN, Run1, __RC__) + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_RUN, Run2, __RC__) + +! ---------------------------------- +! Store private internal state in GC +! ---------------------------------- + call ESMF_UserCompSetInternalState (GC, 'IGNI_State', wrap, STATUS) + VERIFY_(STATUS) + +! ----------------------------------------------------------- +! Get the configuration +! ----------------------------------------------------------- + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + call MAPL_GetResource(MAPL, NUM_ENSEMBLE, label='NUM_LDAS_ENSEMBLE:', DEFAULT=1, __RC__) + + + ! at the moment, this G.C. will refresh when the land parent refreshes + call MAPL_GetResource(MAPL, run_dt, label='RUN_DT:', __RC__) + call MAPL_GetResource(MAPL, dt, label=trim(COMP_NAME)//'_DT:', default=run_dt, __RC__) + + ! set the 'local noon' method property + call MAPL_GetResource(MAPL, resource_file, label='IGNI_RC:', default='GEOS_IgniGridComp.rc', __RC__) + + config = ESMF_ConfigCreate(__RC__) + call ESMF_ConfigLoadFile(config, resource_file, __RC__) + call MAPL_GetResource(config, local_noon, label='LOCAL_NOON:', default='SOLAR', __RC__) + call ESMF_ConfigDestroy(config, __RC__) + + select case (local_noon) + case ('SOLAR') + self%local_noon_method = LOCAL_NOON_SOLAR + case ('LST') + self%local_noon_method = LOCAL_NOON_LST + case DEFAULT + self%local_noon_method = LOCAL_NOON_SOLAR + end select + +! ----------------------------------------------------------- +! Set the state variable specs. +! ----------------------------------------------------------- + +!BOS + +! ----------------------------------------------------------- +! Import States +! ----------------------------------------------------------- + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'MOT2M', & + LONG_NAME = 'temperature 2m from MO sfc',& + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'MOQ2M', & + LONG_NAME = 'humidity 2m from MO sfc', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'MOU10M', & + LONG_NAME = 'zonal 10m wind from MO sfc',& + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'MOV10M', & + LONG_NAME = 'meridional 10m wind from MO sfc', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'surface pressure', & + UNITS = 'Pa', & + SHORT_NAME = 'PS', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + +#if (1) + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'PRLAND', & + LONG_NAME = 'total precipitation land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) +#else + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'liquid water convective precipitation', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'PCU', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'liquid water large scale precipitation', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'PLS', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'snowfall', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SNO', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, __RC__) +#endif + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'ASNOW', & + LONG_NAME = 'fractional area of land snowcover', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'SNOWDP', & + LONG_NAME = 'snow depth within snow covered area fraction', & + UNITS = 'm', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'SWDOWNLAND', & + LONG_NAME = 'incident shortwave land', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + + +! ----------------------------------------------------------- +! Internal State +! ----------------------------------------------------------- + + ! hourly + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'FFMC', & + LONG_NAME = 'fine fuel moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, & + DEFAULT = FFMC_INIT, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'GFMC', & + LONG_NAME = 'grass fuel moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, & + DEFAULT = FFMC_INIT, __RC__) + + ! daily + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'FFMC_DAILY', & + LONG_NAME = 'fine fuel moisture code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, & + DEFAULT = FFMC_INIT, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'DMC_DAILY', & + LONG_NAME = 'duff moisture code (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, & + DEFAULT = DMC_INIT, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'DC_DAILY', & + LONG_NAME = 'drought code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartOptional, & + DEFAULT = DC_INIT, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'DPR_LOCAL_NOON', & + LONG_NAME = 'total precipitation since local noon', & + UNITS = 'kg m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + ADD2EXPORT = .true., & +! PRECISION = MAPL_R4, & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.0, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'PR_LOCAL_NOON', & + LONG_NAME = '24-hr total precipitation at local noon', & + UNITS = 'kg m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + ADD2EXPORT = .true., & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.0, __RC__) + + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'T_LOCAL_NOON', & + LONG_NAME = 'temperature at local noon', & + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + ADD2EXPORT = .true., & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.0, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'RH_LOCAL_NOON', & + LONG_NAME = 'relative humidity at local_noon', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + ADD2EXPORT = .true., & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.50, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'WS_LOCAL_NOON', & + LONG_NAME = 'wind speed at local noon', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + ADD2EXPORT = .true., & + RESTART = MAPL_RestartOptional, & + DEFAULT = 3.0, __RC__) + + +! ----------------------------------------------------------- +! Export Variables +! ----------------------------------------------------------- + + ! hourly + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FFMC', & + LONG_NAME = 'fine fuel moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'GFMC', & + LONG_NAME = 'grass fuel moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DMC', & + LONG_NAME = 'duff moisture code', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DC', & + LONG_NAME = 'drought code', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FWI', & + LONG_NAME = 'fire weather index', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'BUI', & + LONG_NAME = 'buildup index', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ISI', & + LONG_NAME = 'initial spread index', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DSR', & + LONG_NAME = 'daily severity rating', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + + ! daily + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FFMC_DAILY', & + LONG_NAME = 'fine fuel moisture code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DMC_DAILY', & + LONG_NAME = 'duff moisture code (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DC_DAILY', & + LONG_NAME = 'drought code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FWI_DAILY', & + LONG_NAME = 'fire weather index (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'BUI_DAILY', & + LONG_NAME = 'buildup index (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ISI_DAILY', & + LONG_NAME = 'initial spread index (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DSR_DAILY', & + LONG_NAME = 'daily severity rating (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + + ! local noon patches + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FFMC_DAILY_', & + LONG_NAME = 'fine fuel moisture code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DMC_DAILY_', & + LONG_NAME = 'duff moisture code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DC_DAILY_', & + LONG_NAME = 'drought code (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FWI_DAILY_', & + LONG_NAME = 'fire weather index (daily)',& + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'BUI_DAILY_', & + LONG_NAME = 'buildup index (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ISI_DAILY_', & + LONG_NAME = 'initial spread index(daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DSR_DAILY_', & + LONG_NAME = 'daily severity rating (daily)', & + UNITS = '1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + + ! flammability and ignition sources + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'VPD', & + LONG_NAME = 'vapor pressure deficit', & + UNITS = 'Pa', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + +!EOS + + +! Set the Profiling timers +! ------------------------ + call MAPL_TimerAdd(GC, name='TOTAL' , __RC__) +! call MAPL_TimerAdd(GC, name='INITIALIZE', __RC__) + call MAPL_TimerAdd(GC, name='RUN' , __RC__) + call MAPL_TimerAdd(GC, name='-CFFWI' , __RC__) + call MAPL_TimerAdd(GC, name='--daily' , __RC__) + call MAPL_TimerAdd(GC, name='--hourly' , __RC__) +! call MAPL_TimerAdd(GC, name='FINALIZE' , __RC__) + + +!------------------------------------------------------------ +! Set generic init and final methods +!------------------------------------------------------------ + + call MAPL_GenericSetServices(GC, __RC__) + + RETURN_(ESMF_SUCCESS) + + end subroutine SetServices + + + +! ----------------------------------------------------------- +! RUN1 -- Run (phase = 1) method of the IGNI component +! ----------------------------------------------------------- + + subroutine RUN1 (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 + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Locals + + type (MAPL_MetaComp), pointer :: MAPL => null() + + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + + Iam = trim(COMP_NAME) // 'Run' + +! Get my internal MAPL_Generic state +! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + call MAPL_TimerOn(MAPL, 'TOTAL') + call MAPL_TimerOn(MAPL, 'RUN' ) + + +! Get file names from configuration +! ----------------------------------------------------------- + + if (NUM_ENSEMBLE > 1) then + !comp_name should be IGNIxxxx... + end if + + +! All done +! --------- + call MAPL_TimerOff(MAPL, 'RUN' ) + call MAPL_TimerOff(MAPL, 'TOTAL') + + RETURN_(ESMF_SUCCESS) + + end subroutine RUN1 + + + +! ----------------------------------------------------------- +! RUN2 -- Run (phase = 2) method of the IGNI component +! ----------------------------------------------------------- + + subroutine RUN2 (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 + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Locals + + type (MAPL_MetaComp), pointer :: MAPL => null() + + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + + Iam = trim(COMP_NAME) // 'Run2' + +! Get my internal MAPL_Generic state +! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + call MAPL_TimerOn(MAPL, 'TOTAL') + call MAPL_TimerOn(MAPL, 'RUN' ) + + +! Get file names from configuration +! ----------------------------------------------------------- + + if (NUM_ENSEMBLE > 1) then + !comp_name should be IGNIxxxx... + end if + + +! Fire weather indexes +! -------------------- + call MAPL_TimerOn(MAPL, '-CFFWI') + + call MAPL_TimerOn(MAPL, '--daily') + call CFFWI_DAILY (GC, IMPORT, EXPORT, CLOCK, __RC__) + call MAPL_TimerOff(MAPL, '--daily') + + call MAPL_TimerOn(MAPL, '--hourly') + call CFFWI_HOURLY(GC, IMPORT, EXPORT, CLOCK, __RC__) + call MAPL_TimerOff(MAPL, '--hourly') + + call MAPL_TimerOff(MAPL, '-CFFWI') + + +! flammability and ignition sources +! --------------------------------- + call REBURN(GC, IMPORT, EXPORT, CLOCK, __RC__) + + + +! All done +! --------- + call MAPL_TimerOff(MAPL, 'RUN' ) + call MAPL_TimerOff(MAPL, 'TOTAL') + + RETURN_(ESMF_SUCCESS) + + end subroutine RUN2 + + +! ----------------------------------------------------------- +! CFFWI_DAILY -- Runs the daily CFFWI +! ----------------------------------------------------------- + + subroutine CFFWI_DAILY (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 + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + +! Private internal state + type (IGNI_State), pointer :: self + type (wrap_) :: wrap + + +! IMPORT pointers + + real, dimension(:), pointer :: T2M => null() + real, dimension(:), pointer :: Q2M => null() + real, dimension(:), pointer :: U10M => null() + real, dimension(:), pointer :: V10M => null() + real, dimension(:), pointer :: PS => null() + real, dimension(:), pointer :: ASNOW => null() + real, dimension(:), pointer :: SNOWDP => null() + real, dimension(:), pointer :: SWDOWN => null() +#if (1) + real, dimension(:), pointer :: PRLAND => null() +#else + real, dimension(:), pointer :: PCU => null() + real, dimension(:), pointer :: PLS => null() + real, dimension(:), pointer :: SNO => null() +#endif + + +! INTERNAL pointers + + real, dimension(:), pointer :: FFMC0_daily => null() + real, dimension(:), pointer :: DMC0_daily => null() + real, dimension(:), pointer :: DC0_daily => null() + + real, dimension(:), pointer :: DPR_noon => null() + real, dimension(:), pointer :: PR_noon => null() + real, dimension(:), pointer :: RH_noon => null() + real, dimension(:), pointer :: T_noon => null() + real, dimension(:), pointer :: WS_noon => null() + + +! EXPORT pointers + + ! daily + real, dimension(:), pointer :: FFMC_daily => null() + real, dimension(:), pointer :: DMC_daily => null() + real, dimension(:), pointer :: DC_daily => null() + real, dimension(:), pointer :: ISI_daily => null() + real, dimension(:), pointer :: FWI_daily => null() + real, dimension(:), pointer :: BUI_daily => null() + real, dimension(:), pointer :: DSR_daily => null() + + ! local noon + real, dimension(:), pointer :: FFMC_daily_ => null() + real, dimension(:), pointer :: DMC_daily_ => null() + real, dimension(:), pointer :: DC_daily_ => null() + real, dimension(:), pointer :: ISI_daily_ => null() + real, dimension(:), pointer :: FWI_daily_ => null() + real, dimension(:), pointer :: BUI_daily_ => null() + real, dimension(:), pointer :: DSR_daily_ => null() + + +! Misc + + type(MAPL_MetaComp), pointer :: MAPL => null() + type(ESMF_State) :: INTERNAL + type(MAPL_SunOrbit) :: ORBIT + + + type(ESMF_Time) :: time + type(ESMF_Alarm) :: run_alarm + type(ESMF_TimeInterval) :: ring_interval + real(ESMF_KIND_R8) :: time_step + + integer :: NT + + integer :: year, month, day, hr, mn, sc + real :: dt + + real, pointer, dimension(:) :: LATS => null() + real, pointer, dimension(:) :: LONS => null() + + real, allocatable, dimension(:) :: tmpISI + real, allocatable, dimension(:) :: tmpBUI + real, allocatable, dimension(:) :: tmpDSR + real, allocatable, dimension(:) :: tmpFWI + + real, allocatable, dimension(:) :: dt_local_noon + + real, allocatable, dimension(:) :: LSHA0 + real, allocatable, dimension(:) :: LSHA1 + + logical, allocatable, dimension(:) :: isNoon + + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + + Iam = trim(COMP_NAME) // 'CFFWI_DAILY' + + +! Get my internal MAPL_Generic state +! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + + call MAPL_Get(MAPL, TILELATS=LATS, & + TILELONS=LONS, & + INTERNAL_ESMF_STATE=INTERNAL, __RC__) + + NT = SIZE(LONS) + + NO_LAND_AREAS: if (NT == 0) then + RETURN_(ESMF_SUCCESS) + end if NO_LAND_AREAS + + +! Get my private internal state +! ----------------------------- + call ESMF_UserCompGetInternalState (GC, 'IGNI_State', wrap, STATUS) + VERIFY_(STATUS) + self => wrap%ptr + + +! Get pointers to internal variables +! ---------------------------------- + + call MAPL_GetPointer(INTERNAL, FFMC0_daily, 'FFMC_DAILY', __RC__) + call MAPL_GetPointer(INTERNAL, DMC0_daily, 'DMC_DAILY', __RC__) + call MAPL_GetPointer(INTERNAL, DC0_daily, 'DC_DAILY', __RC__) + + call MAPL_GetPointer(INTERNAL, DPR_noon, 'DPR_LOCAL_NOON', __RC__) + call MAPL_GetPointer(INTERNAL, PR_noon, 'PR_LOCAL_NOON', __RC__) + call MAPL_GetPointer(INTERNAL, T_noon, 'T_LOCAL_NOON', __RC__) + call MAPL_GetPointer(INTERNAL, RH_noon, 'RH_LOCAL_NOON', __RC__) + call MAPL_GetPointer(INTERNAL, WS_noon, 'WS_LOCAL_NOON', __RC__) + + +! Get pointers to imports +! ----------------------- + + call MAPL_GetPointer(IMPORT, PS, 'PS', __RC__) + call MAPL_GetPointer(IMPORT, Q2M, 'MOQ2M', __RC__) + call MAPL_GetPointer(IMPORT, T2M, 'MOT2M', __RC__) + call MAPL_GetPointer(IMPORT, U10M, 'MOU10M', __RC__) + call MAPL_GetPointer(IMPORT, V10M, 'MOV10M', __RC__) + call MAPL_GetPointer(IMPORT, ASNOW, 'ASNOW', __RC__) + call MAPL_GetPointer(IMPORT, SNOWDP, 'SNOWDP', __RC__) +#if (1) + call MAPL_GetPointer(IMPORT, PRLAND, 'PRLAND', __RC__) +#else + call MAPL_GetPointer(IMPORT, PCU, 'PCU', __RC__) + call MAPL_GetPointer(IMPORT, PLS, 'PLS', __RC__) + call MAPL_GetPointer(IMPORT, SNO, 'SNO', __RC__) +#endif + + +! Get pointers to exports +! ----------------------- + + ! global + call MAPL_GetPointer(EXPORT, FFMC_daily, 'FFMC_DAILY', __RC__) + call MAPL_GetPointer(EXPORT, DMC_daily, 'DMC_DAILY', __RC__) + call MAPL_GetPointer(EXPORT, DC_daily, 'DC_DAILY', __RC__) + call MAPL_GetPointer(EXPORT, FWI_daily, 'FWI_DAILY', __RC__) + call MAPL_GetPointer(EXPORT, ISI_daily, 'ISI_DAILY', __RC__) + call MAPL_GetPointer(EXPORT, BUI_daily, 'BUI_DAILY', __RC__) + call MAPL_GetPointer(EXPORT, DSR_daily, 'DSR_DAILY', __RC__) + + ! local noon patch + call MAPL_GetPointer(EXPORT, FFMC_daily_, 'FFMC_DAILY_', __RC__) + call MAPL_GetPointer(EXPORT, DMC_daily_, 'DMC_DAILY_', __RC__) + call MAPL_GetPointer(EXPORT, DC_daily_, 'DC_DAILY_', __RC__) + call MAPL_GetPointer(EXPORT, FWI_daily_, 'FWI_DAILY_', __RC__) + call MAPL_GetPointer(EXPORT, ISI_daily_, 'ISI_DAILY_', __RC__) + call MAPL_GetPointer(EXPORT, BUI_daily_, 'BUI_DAILY_', __RC__) + call MAPL_GetPointer(EXPORT, DSR_daily_, 'DSR_DAILY_', __RC__) + + +! Get the time step +! ----------------- + + call MAPL_Get(MAPL, RunAlarm=run_alarm, __RC__) + call ESMF_AlarmGet(run_alarm, ringInterval=ring_interval, __RC__) + + call ESMF_TimeIntervalGet(ring_interval, s_r8=time_step, __RC__) + dt = real(time_step) + + +! Construct local noon mask +! ------------------------- + + call ESMF_ClockGet(CLOCK, currTime=time, __RC__) + call ESMF_TimeGet(time, yy=year, mm=month, dd=day, h=hr, m=mn, s=sc, __RC__) + + allocate(isNoon(NT), __STAT__) + + if (self%local_noon_method == LOCAL_NOON_SOLAR) then +#if (1) + _ASSERT(.false., 'Precise local solar noon is disabled, please select LST instead.') +#else + allocate(LSHA0(NT), LSHA1(NT), __STAT__) + + call MAPL_Get(MAPL, ORBIT=ORBIT, __RC__) + call MAPL_SunGetLocalSolarHourAngle(ORBIT, LONS, LSHA0, TIME=time, __RC__) + call MAPL_SunGetLocalSolarHourAngle(ORBIT, LONS, LSHA1, TIME=time+ring_interval, __RC__) + + isNoon = (LSHA0 <= 0) .and. (LSHA1 > 0) + + deallocate(LSHA0, LSHA1, __STAT__) +#endif + else + allocate(dt_local_noon(NT), __STAT__) + dt_local_noon = ((hr-12)*3600 + mn*60 + sc) + ((24*3600)/(2*MAPL_PI))*LONS + + isNoon = (dt_local_noon >= 0) .and. (dt_local_noon < dt) + + deallocate(dt_local_noon, __STAT__) + end if + + +! Accumulate precip +! ----------------- +#if (1) + DPR_NOON = DPR_NOON + PRLAND*dt +#else + DPR_NOON = DPR_NOON + (PCU + PLS + SNO)*dt +#endif + + +! Update local noon patches +! ------------------------- + + where (isNoon) + T_noon = T2M + WS_noon = sqrt(U10M*U10M + V10M*V10M) + RH_noon = min(Q2M / GEOS_QSAT(T2M, PS, PASCALS=.true.), 1.0) + PR_noon = DPR_noon + DPR_noon = 0.0 + end where + + +! Run the daily system +! -------------------- + allocate(tmpISI(NT), tmpBUI(NT), tmpDSR(NT), tmpFWI(NT), __STAT__) + + tmpISI = MAPL_UNDEF + tmpBUI = MAPL_UNDEF + tmpDSR = MAPL_UNDEF + tmpFWI = MAPL_UNDEF + + call cffwi_daily_driver(FFMC0_daily, DMC0_daily, DC0_daily, & + tmpISI, tmpBUI, tmpFWI, tmpDSR, & + T_noon, RH_noon, WS_noon, PR_noon, & + ASNOW, SNOWDP, LATS, isNoon, month, NT) + +! Update exports +! -------------- + + if (associated(FFMC_daily)) FFMC_daily = FFMC0_daily + if (associated(DMC_daily)) DMC_daily = DMC0_daily + if (associated(DC_daily)) DC_daily = DC0_daily + if (associated(ISI_daily)) ISI_daily = tmpISI + if (associated(BUI_daily)) BUI_daily = tmpBUI + if (associated(FWI_daily)) FWI_daily = tmpFWI + if (associated(DSR_daily)) DSR_daily = tmpDSR + + + if (associated(FFMC_daily_)) then + where (isNoon) + FFMC_daily_ = FFMC0_daily + elsewhere + FFMC_daily_ = MAPL_UNDEF + end where + end if + + if (associated(DMC_daily_)) then + where (isNoon) + DMC_daily_ = DMC0_daily + elsewhere + DMC_daily_ = MAPL_UNDEF + end where + end if + + if (associated(DC_daily_)) then + where (isNoon) + DC_daily_ = DC0_daily + elsewhere + DC_daily_ = MAPL_UNDEF + end where + end if + + if (associated(ISI_daily_)) then + where (isNoon) + ISI_daily_ = tmpISI + elsewhere + ISI_daily_ = MAPL_UNDEF + end where + end if + + if (associated(BUI_daily_)) then + where (isNoon) + BUI_daily_ = tmpBUI + elsewhere + BUI_daily_ = MAPL_UNDEF + end where + end if + + if (associated(FWI_daily_)) then + where (isNoon) + FWI_daily_ = tmpFWI + elsewhere + FWI_daily_ = MAPL_UNDEF + end where + end if + + if (associated(DSR_daily_)) then + where (isNoon) + DSR_daily_ = tmpDSR + elsewhere + DSR_daily_ = MAPL_UNDEF + end where + end if + + + deallocate(tmpISI, tmpBUI, tmpDSR, tmpFWI, __STAT__) + + +! All done +! --------- + + RETURN_(ESMF_SUCCESS) + + end subroutine CFFWI_DAILY + + +! ----------------------------------------------------------- +! CFFWI_HOURLY -- Runs the hourly CFFWI +! ----------------------------------------------------------- + + subroutine CFFWI_HOURLY (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 + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + +! IMPORT pointers + + real, dimension(:), pointer :: T2M => null() + real, dimension(:), pointer :: Q2M => null() + real, dimension(:), pointer :: U10M => null() + real, dimension(:), pointer :: V10M => null() + real, dimension(:), pointer :: PS => null() + real, dimension(:), pointer :: ASNOW => null() + real, dimension(:), pointer :: SNOWDP => null() + real, dimension(:), pointer :: SWDOWN => null() +#if (1) + real, dimension(:), pointer :: PRLAND => null() +#else + real, dimension(:), pointer :: PCU => null() + real, dimension(:), pointer :: PLS => null() + real, dimension(:), pointer :: SNO => null() +#endif + + +! INTERNAL pointers + + real, dimension(:), pointer :: FFMC0 => null() + real, dimension(:), pointer :: GFMC0 => null() + real, dimension(:), pointer :: DMC0 => null() + real, dimension(:), pointer :: DC0 => null() + + +! EXPORT pointers + + ! hourly + real, dimension(:), pointer :: FFMC => null() + real, dimension(:), pointer :: GFMC => null() + real, dimension(:), pointer :: DMC => null() + real, dimension(:), pointer :: DC => null() + real, dimension(:), pointer :: ISI => null() + real, dimension(:), pointer :: FWI => null() + real, dimension(:), pointer :: BUI => null() + real, dimension(:), pointer :: DSR => null() + + +! Misc + + type(MAPL_MetaComp), pointer :: MAPL => null() + type(ESMF_State) :: INTERNAL + + + type(ESMF_Time) :: time + type(ESMF_Alarm) :: run_alarm + type(ESMF_TimeInterval) :: ring_interval + real(ESMF_KIND_R8) :: time_step + + integer :: NT + + integer :: year, month, day, hr, mn, sc + real :: dt + + real, pointer, dimension(:) :: LATS => null() + real, pointer, dimension(:) :: LONS => null() + + real, allocatable, dimension(:) :: tmpISI + real, allocatable, dimension(:) :: tmpBUI + real, allocatable, dimension(:) :: tmpDSR + real, allocatable, dimension(:) :: tmpFWI + + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + + Iam = trim(COMP_NAME) // 'CFFWI_HOURLY' + + +! Get my internal MAPL_Generic state +! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + + call MAPL_Get(MAPL, TILELATS=LATS, & + TILELONS=LONS, & + INTERNAL_ESMF_STATE=INTERNAL, __RC__) + + NT = SIZE(LONS) + + NO_LAND_AREAS: if (NT == 0) then + RETURN_(ESMF_SUCCESS) + end if NO_LAND_AREAS + + +! Get pointers to internal variables +! ---------------------------------- + + call MAPL_GetPointer(INTERNAL, FFMC0, 'FFMC', __RC__) + call MAPL_GetPointer(INTERNAL, GFMC0, 'GFMC', __RC__) + call MAPL_GetPointer(INTERNAL, DMC0, 'DMC_DAILY', __RC__) ! requires daily DMC + call MAPL_GetPointer(INTERNAL, DC0, 'DC_DAILY', __RC__) ! requires daily DC + + +! Get pointers to imports +! ----------------------- + + call MAPL_GetPointer(IMPORT, PS, 'PS', __RC__) + call MAPL_GetPointer(IMPORT, Q2M, 'MOQ2M', __RC__) + call MAPL_GetPointer(IMPORT, T2M, 'MOT2M', __RC__) + call MAPL_GetPointer(IMPORT, U10M, 'MOU10M', __RC__) + call MAPL_GetPointer(IMPORT, V10M, 'MOV10M', __RC__) + call MAPL_GetPointer(IMPORT, ASNOW, 'ASNOW', __RC__) + call MAPL_GetPointer(IMPORT, SNOWDP, 'SNOWDP', __RC__) + call MAPL_GetPointer(IMPORT, SWDOWN, 'SWDOWNLAND', __RC__) +#if (1) + call MAPL_GetPointer(IMPORT, PRLAND, 'PRLAND', __RC__) +#else + call MAPL_GetPointer(IMPORT, PCU, 'PCU', __RC__) + call MAPL_GetPointer(IMPORT, PLS, 'PLS', __RC__) + call MAPL_GetPointer(IMPORT, SNO, 'SNO', __RC__) +#endif + + +! Get pointers to exports +! ----------------------- + + ! global + call MAPL_GetPointer(EXPORT, FFMC, 'FFMC', __RC__) + call MAPL_GetPointer(EXPORT, GFMC, 'GFMC', __RC__) + call MAPL_GetPointer(EXPORT, DMC, 'DMC', __RC__) ! mostly for symmetry, same as DMC_DAILY + call MAPL_GetPointer(EXPORT, DC, 'DC', __RC__) ! mostly for symmetry, same as DC_DAILY + call MAPL_GetPointer(EXPORT, FWI, 'FWI', __RC__) + call MAPL_GetPointer(EXPORT, ISI, 'ISI', __RC__) + call MAPL_GetPointer(EXPORT, BUI, 'BUI', __RC__) + call MAPL_GetPointer(EXPORT, DSR, 'DSR', __RC__) + + +! Get the time step +! ----------------- + + call MAPL_Get(MAPL, RunAlarm=run_alarm, __RC__) + call ESMF_AlarmGet(run_alarm, ringInterval=ring_interval, __RC__) + + call ESMF_TimeIntervalGet(ring_interval, s_r8=time_step, __RC__) + dt = real(time_step) + + +! Get date and time +! ----------------- + + call ESMF_ClockGet(CLOCK, currTime=time, __RC__) + + call ESMF_TimeGet(time, yy=year, mm=month, dd=day, h=hr, m=mn, s=sc, __RC__) + + +! Update local noon patches +! ------------------------- + + allocate(tmpISI(NT), tmpBUI(NT), tmpDSR(NT), tmpFWI(NT), __STAT__) + + tmpISI = MAPL_UNDEF + tmpBUI = MAPL_UNDEF + tmpDSR = MAPL_UNDEF + tmpFWI = MAPL_UNDEF + + call cffwi_hourly_driver(FFMC0, GFMC0, DMC0, DC0, & + tmpISI, tmpBUI, tmpFWI, tmpDSR, & + T2M, & + min(Q2M / GEOS_QSAT(T2M, PS, PASCALS=.true.), 1.0), & + sqrt(U10M*U10M + V10M*V10M), & + PRLAND*dt, & + ASNOW, SNOWDP, & + SWDOWN, & + month, dt/3600.0, NT) + + ! update exports + if (associated(FFMC)) FFMC = FFMC0 + if (associated(GFMC)) GFMC = GFMC0 + if (associated(DMC)) DMC = DMC0 + if (associated(DC)) DC = DC0 + if (associated(ISI)) ISI = tmpISI + if (associated(BUI)) BUI = tmpBUI + if (associated(FWI)) FWI = tmpFWI + if (associated(DSR)) DSR = tmpDSR + + + deallocate(tmpISI, tmpBUI, tmpDSR, tmpFWI, __STAT__) + + +! All done +! --------- + + RETURN_(ESMF_SUCCESS) + + end subroutine CFFWI_HOURLY + + +! ----------------------------------------------------------- +! REBURN -- flammability and ignition sources +! ----------------------------------------------------------- + + subroutine REBURN (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 + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + +! IMPORT pointers + + real, dimension(:), pointer :: T2M => null() + real, dimension(:), pointer :: Q2M => null() + real, dimension(:), pointer :: PS => null() + + +! INTERNAL pointers +! None + + +! EXPORT pointers + + real, dimension(:), pointer :: VPD => null() + + +! misc + + type(MAPL_MetaComp), pointer :: MAPL => null() + type(ESMF_State) :: INTERNAL + + integer :: NT + + real, pointer, dimension(:) :: LATS => null() + real, pointer, dimension(:) :: LONS => null() + + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + + Iam = trim(COMP_NAME) // 'REBURN' + + +! Get my internal MAPL_Generic state +! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + + call MAPL_Get(MAPL, TILELATS=LATS, & + TILELONS=LONS, & + INTERNAL_ESMF_STATE=INTERNAL, __RC__) + + NT = SIZE(LONS) + + NO_LAND_AREAS: if (NT == 0) then + RETURN_(ESMF_SUCCESS) + end if NO_LAND_AREAS + + + +! Get pointers to imports +! ----------------------- + + call MAPL_GetPointer(IMPORT, PS, 'PS', __RC__) + call MAPL_GetPointer(IMPORT, Q2M, 'MOQ2M', __RC__) + call MAPL_GetPointer(IMPORT, T2M, 'MOT2M', __RC__) + + +! Get pointers to exports +! ----------------------- + + call MAPL_GetPointer(EXPORT, VPD, 'VPD', __RC__) + + +! Update diagnostics +! ------------------------- + UPDATE_VPD: if (associated(VPD)) then + ! VPD = e_s - e = e_s * (1 - RH) + ! + ! e_s = P * Qsat/(MAPL_EPSILON + (1 - MAPL_EPSILON)*Qsat) + ! MAPL_EQsat(T) is equivalent to the e_s expression + + VPD = MAPL_EQsat(T2M) * (1 - min(Q2M / GEOS_QSAT(T2M, PS, PASCALS=.true.), 1.0)) + end if UPDATE_VPD + + +! All done +! --------- + + RETURN_(ESMF_SUCCESS) + + end subroutine REBURN + + + + subroutine cffwi_daily_driver(ffmc, dmc, dc, isi, bui, fwi, dsr, & + T, RH, wind, Pr, & + f_snow, snow_depth, & + latitude, is_noon, month, N) + + ! + ! Calculates daily FFMC, DMC, DC, ISI, BUI, FWI and DSR indexes. + ! Note that: + ! - FFMC, DMC, and DC are updated only in areas where the local + ! noon mask is true + ! - ISI, BUI, FWI and DSR are calculated in all areas using + ! the updated FFMC, DMC and DC. + ! + + implicit none + + real, dimension(N), intent(in) :: T, RH, wind, Pr + real, dimension(N), intent(in) :: f_snow, snow_depth + real, dimension(N), intent(in) :: latitude + logical, dimension(N), intent(in) :: is_noon + integer, intent(in) :: month + integer, intent(in) :: N + + real, dimension(N), intent(inout) :: ffmc, dmc, dc, isi, bui, fwi, dsr + + ! local + integer :: i + real :: T_, RH_, Pr_ + real :: lat_ + + real, parameter :: DAILY = 24.0 ! hours + + do i = 1, N + if (is_noon(i)) then + T_ = T(i) - 273.15 ! temperature, C + RH_ = 100 * RH(i) ! relative humidity, % + Pr_ = Pr(i) ! precipitation since local noon, mm + lat_ = MAPL_RADIANS_TO_DEGREES * latitude(i) + + ! update FFMC, DMC and DC + ffmc(i) = fine_fuel_moisture_code(ffmc(i), T_, RH_, wind(i), Pr_, DAILY) + dmc(i) = duff_moisture_code(dmc(i), T_, RH_, Pr_, month) + dc(i) = drought_code(dc(i), T_, Pr_, lat_, month) + end if + + ! calculate ISI, BUI, FWI and DSR + isi(i) = initial_spread_index(ffmc(i), wind(i)) + + if (snow_depth(i) > 1e-3) then + isi(i) = (1 - f_snow(i)) * isi(i) + end if + + bui(i) = buildup_index(dmc(i), dc(i)) + + fwi(i) = fire_weather_index(isi(i), bui(i)) + dsr(i) = daily_severity_rating(fwi(i)) + end do + + end subroutine cffwi_daily_driver + + + + subroutine cffwi_hourly_driver(ffmc, gfmc, dmc, dc, isi, bui, fwi, dsr, & + T, RH, wind, Pr, & + f_snow, snow_depth, & + swdown, & + month, time_step, N) + + ! + ! Calculates daily FFMC, ISI, BUI, FWI and DSR indexes. + ! Note that DMC and DC are from the daily CFFWI and + ! are not modified here. + ! + + implicit none + + real, dimension(N), intent(in) :: T, RH, wind, Pr + real, dimension(N), intent(in) :: f_snow, snow_depth + real, dimension(N), intent(in) :: swdown + integer, intent(in) :: month + real, intent(in) :: time_step + integer, intent(in) :: N + + real, dimension(N), intent(in ) :: dmc, dc + real, dimension(N), intent(inout) :: ffmc, gfmc, isi, bui, fwi, dsr + + ! local + integer :: i + real :: T_, RH_, Pr_ + + + do i = 1, N + T_ = T(i) - 273.15 ! temperature, C + RH_ = 100 * RH(i) ! relative humidity, % + Pr_ = Pr(i) ! precipitation, mm + + ! update FFMC + ffmc(i) = fine_fuel_moisture_code(ffmc(i), T_, RH_, wind(i), Pr_, time_step) + + ! update GFMC + gfmc(i) = grass_fuel_moisture_code(gfmc(i), T_, RH_, wind(i), Pr_, & + swdown(i), NOMINAL_FINE_FUEL_LOAD, time_step) + + ! calculate ISI, BUI, FWI and DSR + isi(i) = initial_spread_index(ffmc(i), wind(i)) + + if (snow_depth(1) > 1e-3) then + isi(i) = (1 - f_snow(i)) * isi(i) + end if + + bui(i) = buildup_index(dmc(i), dc(i)) + + fwi(i) = fire_weather_index(isi(i), bui(i)) + dsr(i) = daily_severity_rating(fwi(i)) + end do + + end subroutine cffwi_hourly_driver + + +end module GEOS_IgniGridCompMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.rc new file mode 100644 index 000000000..0350de273 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.rc @@ -0,0 +1 @@ +LOCAL_NOON: LST # either SOLAR or LST diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/cffwi.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/cffwi.F90 new file mode 100755 index 000000000..a047d3d27 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/cffwi.F90 @@ -0,0 +1,682 @@ +! +! Implementation of the Canadian Forest Fire +! Canadian Forest Fire Weather Index System (CFFWI) +! +! References: +! 1) Van Wagner, C.E. and T.L. Picket, 1985. +! 2) Van Wagner, C.E., A method of computing fine fuel +! moisture content throughout the diurnal cycle, 1977. +! 3) Lawson, B.D. and Armitage, O.B, Weather guide +! for the Canadian Forest Fire Danger Rating System, 2008. +! 4) Kerry Anderson, A comparison of hourly fine fuel moisture +! code calculations within Canada, 2009. +! 5) Wotton, B.M., A grass moisture model for the +! Canadian Forest Fire Danger Rating System, 2009. +! 6) Wotton, B.M., Alexander, M.E. and Taylor, S.W., Updates and +! Revisions to the 1992 Canadian Forest Fire Behavior +! Prediction System, GLC-X-10, 2009. +! +! Milestones: +! Anton Darmenov, NASA, 2023 -- add grass FMC +! Anton Darmenov, NASA, 2023 -- add hourly FFMC +! Anton Darmenov, NASA, 2023 -- adjustments for applying the system globally +! Anton Darmenov, NASA, 2022 -- refactor +! Anton Darmenov, NASA, 2010 -- initial implementation +! + +module cffwi + +implicit none + +private + +public :: fine_fuel_moisture_code +public :: duff_moisture_code +public :: drought_code +public :: initial_spread_index +public :: buildup_index +public :: fire_weather_index +public :: daily_severity_rating + +public :: grass_fuel_moisture_code + +public :: drought_code_lf +public :: cffwi_indexes + +real, public, parameter :: FFMC_INIT = 85.0 +real, public, parameter :: DMC_INIT = 6.0 +real, public, parameter :: DC_INIT = 15.0 + +real, public, parameter :: CFFWI_REFERENCE_LATITUDE = 46.0 ! Canada, 46N + +real, public, parameter :: NOMINAL_FINE_FUEL_LOAD = 0.35 ! kg m-2 + +contains + + +elemental real function ff_scale_mc(ffmc) + + ! + ! Converts Fine Fuel Moisture Code (FFMC) to moisture content (%). + ! + ! Default values and units: + ! ffmc = FFMC (default = 85) + + implicit none + + real, intent(in) :: ffmc + + ff_scale_mc = 147.27723*(101 - ffmc) / (59.5 + ffmc) + +end function ff_scale_mc + + + +elemental real function ff_scale_ffmc(mc) + + ! + ! Converts moisture content (%) to Fine Fuel Moisture Code (FFMC). + ! + ! Default values and units: + ! mc = 16.31 (corresponds to FFMC=85 on the FF scale) + + implicit none + + real, intent(in) :: mc + + ff_scale_ffmc = 59.5*(250 - mc)/(147.27723 + mc) + +end function ff_scale_ffmc + + + +elemental real function fine_fuel_moisture_code(ffmc, T, RH, wind, Pr, dt) + + ! + ! Calculates either hourly or daily Fine Fuel Moisture Code (FFMC). + ! + ! Default values and units: + ! ffmc = initial FFMC (default = 85) + ! T = temperature, C + ! RH = relative humidity, % + ! wind = wind speed, m/s + ! Pr = precip, mm; | dt <= 1hr: precip over the time step + ! ! dt > 1hr: 24-hour precip + ! dt = time step, hr; | dt <= 1hr: trigers the hourly FFMC model + ! | dt > 1hr: trigers the daily FFMC model + ! + ! + ! Note: + ! Weather data are observed either hourly or at local noon. + ! + + implicit none + + real, intent(in) :: ffmc, T, RH, wind, Pr + real, intent(in) :: dt + + ! local + real :: f_0, w, m_0, h + real :: r_f, m_r, dm, e_d, e_w, m + real :: k_0, k_l, k_d, k_w, f_k, f_t + real :: E_H_term, E_T_term + real :: result + + real, parameter :: k_factor_hourly = 0.0579 + real, parameter :: k_factor_daily = 0.581 + + + ! use the same variable names as in the FFMC equation and + ! convert units if necessary + f_0 = ffmc + w = 3.6 * wind ! convert from m/s to km/h + + + ! initial fuel moisture content (FF scale) + m_0 = ff_scale_mc(f_0) + + ! current fuel moisture content + m_r = m_0 + + if (dt <= 1.0) then + f_k = k_factor_hourly + f_t = dt + + ! canopy effect is not considered in the hourly calculations + r_f = Pr + else + f_k = k_factor_daily + f_t = 1.0 + + ! rainfall correction due to canopy effect + r_f = max(0.0, Pr - 0.5) + end if + + ! rainfall effect + if (r_f > tiny(r_f)) then + m_r = m_0 + 42.5 * r_f * exp(-100.0/(251.0 - m_0)) * (1 - exp(-6.93/r_f)) + + if (m_0 > 150) then + dm = m_0 - 150 + m_r = m_r + 0.0015 * (dm*dm) * sqrt(r_f) + end if + + ! fuel moisture content has upper limit of 250 + if (m_r > 250) then + m_r = 250.0 + end if + end if + + ! equilibrium moisture contents for drying (E_d) and wetting (E_w) conditions + E_H_term = exp(0.1 * (RH - 100.0)) + E_T_term = 0.18*(21.1 - T) * (1 - exp(-0.115*RH)) + E_d = 0.942*(RH**0.679) + 11*E_H_term + E_T_term + E_w = 0.618*(RH**0.753) + 10*E_H_term + E_T_term + + h = RH / 100.0 + + if (m_r > E_d) then + ! drying is in effect + k_0 = 0.424 * (1 - (h**1.7)) + 0.0694 * sqrt(w) * (1 - (h**8)) + k_d = k_0 * f_k * exp(0.0365 * T) + + m = E_d + (m_r - E_d)*(10.0**(-k_d*f_t)) + else + if (m_r < E_w) then + ! wetting is in effect + k_l = 0.424 * (1 - (1 - h)**1.7) + 0.0694 * sqrt(w)* (1 - (1 - h)**8) + k_w = k_l * f_k * exp(0.0365 * T) + + m = E_w - (E_w - m_r)*(10.0**(-k_w*f_t)) + else + ! maintain moisture + m = m_r + end if + end if + + + ! current FFMC (FF scale) + result = ff_scale_ffmc(m) + + ! clamp FFMC within [0, 101] + fine_fuel_moisture_code = max(0.0, min(101.0, result)) + +end function fine_fuel_moisture_code + + + +elemental real function grass_fuel_moisture_code(gfmc, T, RH, wind, Pr, sw_down, ff_load, dt) + + ! + ! Calculates hourly Grass Fuel Moisture Code (GFMC). + ! + ! Default values and units: + ! gfmc = initial GFMC (default = 85) + ! T = temperature, C + ! RH = relative humidity, % + ! wind = wind speed, m/s + ! Pr = precip, mm; | dt <= 1hr: precip over the time step + ! ! dt > 1hr: 24-hour precip + ! SW_down = incident shortwave flux, W m-2 + ! ff_load = fuel load of the fine fuel layer, kg m-2 (default = 0.3 kg m-2) + ! dt = time step, hr + ! + ! + ! Note: + ! Weather data are observed hourly. + ! + + implicit none + + real, intent(in) :: gfmc, T, RH, wind, Pr, sw_down, ff_load + real, intent(in) :: dt + + ! local + real :: f_0, w, m_0, h, I_sol + real :: r_f, m_r, e_d, e_w, m + real :: k_0, k_l, k_d, k_w, f_k, f_t + real :: E_T_term + real :: T_fuel, RH_fuel, svp, svp_fuel + real :: result + + real, parameter :: k_factor_hourly = 0.389633 + + + + ! convert units if necessary + f_0 = gfmc + w = 3.6 * wind ! convert from m/s to km/h + I_sol = 1e-3 * sw_down ! convert from W m-2 to kW m-2 + + ! initial fuel moisture content (FF scale) + m_0 = ff_scale_mc(f_0) + + ! current fuel moisture content + m_r = m_0 + + f_k = k_factor_hourly + f_t = dt + + ! canopy effect is not considered in the hourly calculations + r_f = Pr + + ! rainfall effect + m_r = m_r + 100 * (r_f / ff_load) + + ! fuel moisture content has upper limit of 250 + m_r = min(m_r, 250.0) + + ! fuel temperature + T_fuel = T + 35.07 * I_sol * exp(-0.06215 * w) + + ! saturation vapor pressure + svp = 6.108 * 10**(7.5 * T / (237.3 + T)) ! Tetens equation + + ! saturation vapor pressure for fuel temperature + svp_fuel = 6.108 * 10**(7.5 * T_fuel / (237.3 + T_fuel)) + + ! fuel level relative humidity + RH_fuel = RH * (svp / svp_fuel) + + ! equilibrium moisture contents for drying (E_d) and wetting (E_w) conditions + E_T_term = 0.27 * (26.7 - T_fuel) * (1 - exp(-0.115 * RH_fuel)) + E_d = 1.62*RH_fuel**0.532 + 13.7*exp((RH_fuel - 100) / 13.0) + E_T_term + E_w = 1.42*RH_fuel**0.512 + 12.0*exp((RH_fuel - 100) / 18.0) + E_T_term + + h = RH_fuel / 100.0 + + if (m_r > E_d) then + ! drying is in effect + k_0 = 0.424 * (1 - (h**1.7)) + 0.0694 * sqrt(w) * (1 - (h**8)) + k_d = k_0 * f_k * exp(0.0365 * T_fuel) + + m = E_d + (m_r - E_d)*(10.0**(-k_d*f_t)) + else + if (m_r < E_w) then + ! wetting is in effect + k_l = 0.424 * (1 - (1 - h)**1.7) + 0.0694 * sqrt(w)* (1 - (1 - h)**8) + k_w = k_l * f_k * exp(0.0365 * T_fuel) + + m = E_w - (E_w - m_r)*(10.0**(-k_w*f_t)) + else + ! maintain moisture + m = m_r + end if + end if + + + ! current GFMC (FF scale) + result = ff_scale_ffmc(m) + + ! clamp GFMC within [0, 101] + grass_fuel_moisture_code = max(0.0, min(101.0, result)) + +end function grass_fuel_moisture_code + + + +elemental real function duff_moisture_code(dmc, T, RH, Pr, month) + + ! + ! Calculates the Duff Moisture Code (DMC). + ! + ! Default values and units: + ! dmc = initial DMC (default = 6) + ! T = temperature, C + ! RH = relative humidity, % + ! Pr = 24-hour precipitation, mm + ! month = [1, 12] + ! + ! Note: + ! Weather data are measured at local noon. + ! + + implicit none + + real, intent (in) :: dmc, T, RH, Pr + integer, intent (in) :: month + + + !local + real, dimension (12), parameter :: & + EFFECTIVE_DAY_LENGTH = (/ 6.5, 7.5, 9.0, 12.8, 13.9, 13.9, & + 12.4, 10.9, 9.4, 8.0, 7.0, 6.0 /) + + real :: p_0, L_e + real :: p, M_0, b, M_r, p_r, k, r_e + + + ! use the same variable names as in the DMC equation and + ! convert the units if necessary + p_0 = dmc + L_e = EFFECTIVE_DAY_LENGTH(month) + + + p = p_0 + + ! rainfall correction + if (Pr > 1.5) then + r_e = 0.92*Pr - 1.27 + + M_0 = 20.0 + exp(5.6348 - p_0/43.43) + + if (p_0 <= 33) then + b = 100/(0.5 + 0.3*p_0) + else if (p_0 <= 65) then + b = 14 - 1.3 * log(p_0) + else ! p_0 > 65 + b = 6.2 * log(p_0) - 17.2 + end if + + M_r = M_0 + 1000*r_e/(48.77 + b*r_e) + p_r = 244.72 - 43.43 * log(M_r - 20.0) + + ! p_r should be positive + p = max(0.0, p_r) + end if + + + ! if T < -1.1C then k is set to 0.0 + k = 1.894e-6 * max(0.0, (T + 1.1)) * (100 - RH) * L_e + + ! current DMC + duff_moisture_code = p + 100*k + +end function duff_moisture_code + + + +elemental real function drought_code(dc, T, Pr, latitude, month) + + ! + ! Calculates the Drought Code (DC). + ! + ! Default values and units: + ! dc = initial DC (default = 15.0) + ! T = temperature, C + ! Pr = 24-hour precipitation, mm + ! month = [1..12] + ! + ! Note: + ! Weather data are measured at local noon. + ! + + implicit none + + real, intent(in) :: dc, T, Pr + real, intent(in) :: latitude + integer, intent(in) :: month + + + ! local + real :: d_0, L_f + real :: d, Q_0, Q_r, r_d, d_r, V, result + + ! use the same variable names as in the DC equation and + ! convert the units if necessary + d_0 = dc + L_f = drought_code_lf(latitude, month) + + + d = d_0 + + ! rainfall correction + if (Pr > 2.8) then + r_d = 0.83 * Pr - 1.27 + + Q_0 = 800 * exp(-d_0 / 400) + Q_r = Q_0 + 3.937 * r_d + + d_r = 400 * log(800 / Q_r) + + ! d_r should be positive + d = max(0.0, d_r) + end if + + ! temperature correction + if (T > -2.8) then + V = 0.36*(T + 2.8) + L_f + else + V = 0.0 + end if + + + ! current DC + result = d + 0.5*V + + drought_code = max(0.0, result) + +end function drought_code + + + +elemental real function drought_code_lf(latitude, month) + + ! + ! Calculates monthly day length adjustment factors for + ! Drought Code (Lf). + ! + ! Includes latitude considerations in adapting the system + ! for global use -- can be applied for northern and southern + ! hemispheres. Based on Appendix 3 in Lawson and Armitage (2008) + ! + + implicit none + + real, intent(in) :: latitude ! degrees + integer, intent(in) :: month + + + ! local + real, dimension(12), parameter :: & + DAY_LENGTH_FACTOR = (/ -1.6, -1.6, -1.6, 0.9, 3.8, 5.8, & + 6.4, 5.0, 2.4, 0.4, -1.6, -1.6 /) + + real, parameter :: DAY_LENGTH_FACTOR_EQUATOR = 1.4 + + real :: L_f + + + if (latitude > 10.0) then + ! use the reference values (Canada) north of 10N + L_f = DAY_LENGTH_FACTOR(month) + else if (latitude < -10.0) then + ! reverse the standard values used in Canada for seasons + ! in the southern hemisphere: NH Jul -> SH Jan, NH Aug -> SH Feb, etc. + L_f = DAY_LENGTH_FACTOR(mod(month+5, 12) + 1) + else + ! for locations near the equator, from 10S to 10N, + ! use the mean DC day length adjustment value (Lf = 1.4) year-round + L_f = DAY_LENGTH_FACTOR_EQUATOR + end if + + drought_code_lf = L_f + +end function drought_code_lf + + + +elemental real function initial_spread_index(ffmc, wind) + + ! + ! Calculates the Initial Spread Index (ISI). + ! + ! Default values and units: + ! ffmc = initial FFMC (default = 85.0) + ! wind = wind speed, m/s + ! + ! Note: + ! Weather data are measured at local noon. + ! + + implicit none + + real, intent (in) :: ffmc, wind + + ! local + real :: w, m, fun_w, fun_f + + + ! use the same variable names as in the DC equation and + ! convert the units if necessary + w = 3.6 * wind ! convert from m/s to km/h + + ! FF scale + m = ff_scale_mc(ffmc) + + if (w < 40) then + fun_w = exp(0.05039 * w) + else + ! modification at the extreme end of winds + fun_w = 12 * (1 - exp(-0.0818 * (w - 28))) + end if + + fun_f = 91.9 * exp(-0.1386 * m) * (1 + (m**5.31)/4.93e7) + + ! current ISI + initial_spread_index = 0.208 * fun_w * fun_f + +end function initial_spread_index + + + +elemental real function buildup_index(dmc, dc) + + ! + ! Calculates the Buildup Index (BUI). + ! + ! Default values and units: + ! dmc = Duff Moisture Code (default = 6.5) + ! dc = Drought Code (default = 15.0) + ! + + implicit none + + real, intent (in) :: dmc, dc + + ! local + real :: result + + if (dmc > 0 .and. dc > 0) then + if (dmc > 0.4*dc) then + result = dmc - (1 - 0.8*dc/(dmc + 0.4*dc)) * (0.92 + (0.0114*dmc)**1.7) + else + result = 0.8 * dmc * dc / (dmc + 0.4*dc) + end if + else + result = 0.0 + end if + + ! current BUI + buildup_index = max(0.0, result) + +end function buildup_index + + + +elemental real function fire_weather_index(isi, bui) + + ! + ! Calculates the Fire Weather Index (FWI). + ! + ! Default values and units: + ! isi = Initial Spread Index (default = 0.0) + ! bui = Buildup Index (default = 0.0) + ! + + implicit none + + real, intent(in) :: isi, bui + + ! local + real :: f, B, result + + + if (bui > 80) then + f = 1000/(25 + 108.64 * exp(-0.023 * bui)) + else + f = 0.626 * (bui**0.809) + 2 + end if + + B = 0.1 * isi * f + + if (B > 1) then + result = exp(2.72 * (0.434 * log(B))**0.647) + else + result = B + end if + + ! current FWI + fire_weather_index = result + +end function fire_weather_index + + + +elemental real function daily_severity_rating(fwi) + + ! + ! Calculates the Daily Severity Rating (DSR). + ! + ! Default values and units: + ! fwi = Fire Weather Index + ! + + implicit none + + real, intent(in) :: fwi + + ! current DSR + daily_severity_rating = 0.0272 * fwi**1.77 + +end function daily_severity_rating + + + +subroutine cffwi_indexes(ffmc_initial, dmc_initial, dc_initial, & + T, RH, wind, Pr, & + latitude, month, time_step, & + ffmc, dmc, dc, isi, bui, fwi, dsr) + + ! Calculates FFMC, DMC, DC, ISI, BUI, FWI and DSR indexes. + ! + ! Default values and units: + ! ffmc_initial = previous hour|day FFMC (default = 85) + ! dmc_initial = previous hour|day DMC (default = 6) + ! dc_initial = previous hour|day DC (default = 15) + ! T = temperature, C + ! RH = relative humidity, % + ! wind = wind speed, m/s + ! Pr = 24-hour precipitation, mm + ! time_step = time step, hr; values <= 1, trigger hourly FFMC + ! values > 1, trigger daily FFMC + ! + ! Note: + ! Weather data are measured either hourly or at local noon. + ! + + implicit none + + real, intent(in) :: ffmc_initial, dmc_initial, dc_initial + real, intent(in) :: T, RH, wind, Pr + integer, intent(in) :: month + real, intent(in) :: latitude + real, intent(in) :: time_step + real, intent(out) :: ffmc, dmc, dc, isi, bui, fwi, dsr + + + ! update fuel moisture codes + ffmc = fine_fuel_moisture_code(ffmc_initial, T, RH, wind, Pr, time_step) + dmc = duff_moisture_code(dmc_initial, T, RH, Pr, month) + dc = drought_code(dc_initial, T, Pr, latitude, month) + + ! update fire behavior indexes + isi = initial_spread_index(ffmc, wind) + bui = buildup_index(dmc, dc) + + fwi = fire_weather_index(isi, bui) + dsr = daily_severity_rating(fwi) + +end subroutine cffwi_indexes + +end module cffwi diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/Makefile b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/Makefile new file mode 100644 index 000000000..bcff607ee --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/Makefile @@ -0,0 +1,9 @@ +all: cffwi-test + ./cffwi-test + +cffwi-test: + gfortran -g -Wall -o cffwi-test ../cffwi.F90 ./cffwi-test.F90 + +clean: + rm ./cffwi.mod + rm ./cffwi-test diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/cffwi-test.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/cffwi-test.F90 new file mode 100755 index 000000000..045711c8b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/cffwi-test.F90 @@ -0,0 +1,134 @@ +! +! Test the implementation of the Canadian Forest Fire +! Weather Index (CFFWI). +! +! +! Anton Darmenov, NASA, 2022 +! + + +! +! Buld executable: +! $ gfortran -g -Wall -o cffwi-test cffwi.F90 cffwi-test.F90 +! + +program cffwi_test + + use cffwi, only: fine_fuel_moisture_code, duff_moisture_code, & + drought_code, initial_spread_index, buildup_index, & + fire_weather_index, daily_severity_rating, & + cffwi_indexes, & + FFMC_INIT, DMC_INIT, DC_INIT, & + CFFWI_REFERENCE_LATITUDE + + + implicit none + + logical, parameter :: INDIVIDUAL_INDEXES = .False. + + real, parameter :: FFMC_DEFAULT = FFMC_INIT + real, parameter :: DMC_DEFAULT = DMC_INIT + real, parameter :: DC_DEFAULT = DC_INIT + + + ! local + real :: ffmc_pd, dmc_pd, dc_pd + real :: ffmc, dmc, dc, fwi, bui, dsr, isi + real :: T, RH, wind, rain + real :: time_step + real :: latitude + integer :: month + + + time_step = 24.0 ! values larger than 1 will triger daily FFMC + latitude = CFFWI_REFERENCE_LATITUDE + + ffmc_pd = FFMC_DEFAULT + dmc_pd = DMC_DEFAULT + dc_pd = DC_DEFAULT + + + !! conditions - heavy rain + !ffmc_pd = 89.7 + !dmc_pd = 57.4 + !dc_pd =108.8 + ! + !T = 16.0 + !RH = 50.0 + !wind = 22.0 + !rain = 12.2 + !month= 5 + + !! conditions- moderate rain + !ffmc_pd = 87.7 + !dmc_pd = 8.5 + !dc_pd = 19.0 + ! + !T = 20.0 + !RH = 21.0 + !wind = 25.0 + !rain = 2.4 + !month= 4 + + !! conditions - no rain + !ffmc_pd = 86.2 + !dmc_pd = 10.4 + !dc_pd = 23.6 + ! + !T = 8.5 + !RH = 40.0 + !wind = 17.0 + !rain = 0.0 + !month= 4 + + !! conditions - no rain and hot weather + ffmc_pd = 77.6 + dmc_pd = 18.7 + dc_pd =117.7 + + T = 30.0 + RH = 38.0 + wind = 22.0 + rain = 0.0 + month= 5 + + ! convert from km/h to m/s + wind = wind / 3.6 + + + if (INDIVIDUAL_INDEXES) then + write (*, '(A)') "Testing the individual cffwi indexes:" + + ffmc = fine_fuel_moisture_code(ffmc_pd, T, RH, wind, rain, time_step) + + dmc = duff_moisture_code(dmc_pd, T, RH, rain, month) + + + dc = drought_code(dc_pd, T, rain, latitude, month) + + isi = initial_spread_index(ffmc, wind) + bui = buildup_index(dmc, dc) + + fwi = fire_weather_index(isi, bui) + dsr = daily_severity_rating(fwi) + else + write (*, '(A)') "Testing the cffwi_indexes():" + + call cffwi_indexes(ffmc_pd, dmc_pd, dc_pd, & + T, RH, wind, rain, & + latitude, month, & + time_step, & + ffmc, dmc, dc, isi, bui, fwi, dsr) + end if + + write (*, '(A, F6.1)') " FFMC = ", ffmc + write (*, '(A, F6.1)') " DMC = ", dmc + write (*, '(A, F6.1)') " DC = ", dc + write (*, '(A)') " -------------" + write (*, '(A, F6.1)') " ISI = ", isi + write (*, '(A, F6.1)') " BUI = ", bui + write (*, '(A)') " -------------" + write (*, '(A, F6.1)') " FWI = ", fwi + write (*, '(A, F6.2)') " DSR = ", dsr + +end program diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/drought_code_lf-test.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/drought_code_lf-test.F90 new file mode 100755 index 000000000..e66813894 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/drought_code_lf-test.F90 @@ -0,0 +1,55 @@ +! +! Test the implementation of the monthly day length adjustment +! factors for Drought Code (Lf) in the CFFWI module. +! +! +! Anton Darmenov, NASA, 2023 +! + + +! +! Buld executable: +! $ gfortran -g -Wall -o cffwi_dc_lf-test cffwi.F90 drought_code_lf-test.F90 +! + +program cffwi_dc_le_test + + use cffwi, only: drought_code_lf, & + CFFWI_REFERENCE_LATITUDE + + + implicit none + + ! local + integer :: month + + + real, dimension(12), parameter :: & + DAY_LENGTH_FACTOR_NH = (/ -1.6, -1.6, -1.6, 0.9, 3.8, 5.8, & + 6.4, 5.0, 2.4, 0.4, -1.6, -1.6 /) + + real, dimension(12), parameter :: & + DAY_LENGTH_FACTOR_SH = (/ 6.4, 5.0, 2.4, 0.4, -1.6, -1.6, & + -1.6, -1.6, -1.6, 0.9, 3.8, 5.8 /) + + + write (*, '(A)') "Testing the monthly day length adjustment factors for Drought Code (Lf):" + write (*, '(A)') "" + + write (*, '(A)') "Northern hemisphere:" + do month = 1, 12 + write (*, '(A, I2, F6.2, F6.2)') " month = ", month, & + DAY_LENGTH_FACTOR_NH(month), & + drought_code_lf(CFFWI_REFERENCE_LATITUDE, month) + end do + + write (*, '(A)') "" + + write (*, '(A)') "Southern hemisphere:" + do month = 1, 12 + write (*, '(A, I2, F6.2, F6.2)') " month = ", month, & + DAY_LENGTH_FACTOR_SH(month), & + drought_code_lf(-CFFWI_REFERENCE_LATITUDE, month) + end do + +end program diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 index be7ec9295..8ba3ede1b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 @@ -10,18 +10,6 @@ module mk_restarts_getidsMod public :: to_radian ! should really be replaced with "MAPL_DEGREES_TO_RADIANS" public :: haversine - ! Copies of the following subroutines - ! - ! to_radian() - ! haversine() - ! ReadCNTilFile() [renamed here to ReadTileFile_RealLatLon()] - ! - ! also exist in - ! - ! ./GEOSsurface_GridComp/Shared/Raster/comp_CATCHCN_AlbScale_parameters.F90 - ! - ! - reichle, 4 Mar 2020 - interface GetIds module procedure GetIds_fast_1p module procedure GetIds_accurate_mpi diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt index e20ff706b..add425bac 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt @@ -1,51 +1 @@ -esma_set_this(OVERRIDE raster) -set (srcs -date_time_util.F90 -leap_year.F90 -EASE_conv.F90 -mod_process_hres_data.F90 -rasterize.F90 -read_riveroutlet.F90 -CubedSphere_GridMod.F90 -rmTinyCatchParaMod.F90 -zip.c -util.c -) - -if(NOT FORTRAN_COMPILER_SUPPORTS_FINDLOC) - list(APPEND srcs findloc.F90) -endif () - -set_source_files_properties(mkMITAquaRaster.F90 PROPERTIES COMPILE_FLAGS "${BYTERECLEN}") - -esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran OpenMP::OpenMP_C) - -if(NOT FORTRAN_COMPILER_SUPPORTS_FINDLOC) - target_compile_definitions(${this} PRIVATE USE_EXTERNAL_FINDLOC) -endif () - -# MAT NOTE This should use find_package(ZLIB) but Baselibs currently -# confuses find_package(). This is a hack until Baselibs is -# reorganized. -if (Baselibs_FOUND) - set (INC_ZLIB ${BASEDIR}/include/zlib) - target_include_directories(${this} PRIVATE ${INC_ZLIB}) -else () - find_package(ZLIB) - target_link_libraries(${this} PRIVATE ZLIB::zlib) -endif () - -ecbuild_add_executable (TARGET chk_clsm_params.x SOURCES chk_clsm_params.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET CombineRasters.x SOURCES CombineRasters.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mkCatchParam.x SOURCES mkCatchParam.F90 LIBS MAPL ${this} OpenMP::OpenMP_Fortran) -ecbuild_add_executable (TARGET mkCubeFVRaster.x SOURCES mkCubeFVRaster.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mkLandRaster.x SOURCES mkLandRaster.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mkLatLonRaster.x SOURCES mkLatLonRaster.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mkLISTilesPara.x SOURCES mkLISTilesPara.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mkMITAquaRaster.x SOURCES mkMITAquaRaster.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mkMOMAquaRaster.x SOURCES mkMOMAquaRaster.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET FillMomGrid.x SOURCES FillMomGrid.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mk_runofftbl.x SOURCES mk_runofftbl.F90 LIBS MAPL ${this}) -ecbuild_add_executable (TARGET mkEASETilesParam.x SOURCES mkEASETilesParam.F90 LIBS MAPL ${this}) - -install(PROGRAMS make_bcs clsm_plots.pro plot_curves.pro create_README.csh plot_curves.csh DESTINATION bin) +esma_add_subdirectories (makebcs preproc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/Raster.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/Raster.h deleted file mode 100644 index 90a7e04d6..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/Raster.h +++ /dev/null @@ -1,6 +0,0 @@ - -#define VERIFY_(A) IF(A/=0)THEN;PRINT *,'ERROR AT LINE ', __LINE__;STOP;ENDIF -#define _ASSERT(A,msg) if(.not.A)then;print *,'Error:',__FILE__,__LINE__;stop;endif -#define REAL_ real(kind=8) -#define RASTER_PI 3.14159265358979323846264338_8 -#define RASTERUNDEF -999 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 deleted file mode 100644 index 71f0d88c6..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 +++ /dev/null @@ -1,431 +0,0 @@ -#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 - -PROGRAM create_vegdyn_ndvi - -! USAGE : ./create_vegdyn_ndvi BCSDIR GFILE, IMxJM JPLH OUTDIR -! EXAMPLES -! bin/create_vegdyn_ndvi /discover/nobackup/ltakacs/bcs/Ganymed-4_0/SMAP_EASEv2/SMAP_EASEv2_M36/ SMAP_EASEv2_M36_964x406 964x406_DE 0 M2/M36/ -! bin/create_vegdyn_ndvi /discover/nobackup/ltakacs/bcs/Ganymed-4_0/SMAP_EASEv2/SMAP_EASEv2_M09/ SMAP_EASEv2_M09_3856x1624 3856x1624_DE 0 M2/M09/ -! bin/create_vegdyn_ndvi /discover/nobackup/ltakacs/bcs/Ganymed-4_0/Ganymed-4_0_MERRA-2/DC0144xPC0091_DE1440xPE0720/ DC0144xPC0091_DE1440xPE0720-Pfafstetter 144x91_DC 0 M2/DC144/ -! bin/create_vegdyn_ndvi /discover/nobackup/ltakacs/bcs/Ganymed-4_0/Ganymed-4_0_MERRA-2/DC0288xPC0181_DE1440xPE0720/ DC0288xPC0181_DE1440xPE0720-Pfafstetter 288x181_DC 0 M2/DC288/ -! bin/create_vegdyn_ndvi /discover/nobackup/ltakacs/bcs/Ganymed-4_0/Ganymed-4_0_MERRA-2/DC0576xPC0361_DE1440xPE0720/ DC0576xPC0361_DE1440xPE0720-Pfafstetter 576x361_DC 0 M2/DC576/ -! bin/create_vegdyn_ndvi /discover/nobackup/ltakacs/bcs/Ganymed-4_0/Ganymed-4_0_MERRA-2/DC1152xPC0721_DE1440xPE0720/ DC1152xPC0721_DE1440xPE0720-Pfafstetter 1152x721_DC 0 M2/DC1152/ -! bin/create_vegdyn_ndvi /discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v001/SMAP_EASEv2_M36/ SMAP_EASEv2_M36_964x406 964x406_DE 0 smapv1/M36/ -! bin/create_vegdyn_ndvi /discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v001/SMAP_EASEv2_M09/ SMAP_EASEv2_M09_3856x1624 3856x1624_DE 0 smapv1/M09/ -! bin/create_vegdyn_ndvi /discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v001/DC0576xPC0361_DE0360xPE0180/ DC0576xPC0361_DE0360xPE0180-Pfafstetter 576x361_DC 0 smapv1/DC576/ -! bin/create_vegdyn_ndvi /discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v002/SMAP_EASEv2_M36/ SMAP_EASEv2_M36_964x406 964x406_DE 1 smapv2/M36/ -! bin/create_vegdyn_ndvi /discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v002/SMAP_EASEv2_M09/ SMAP_EASEv2_M09_3856x1624 3856x1624_DE 1 smapv2/M09/ - - use rmTinyCatchParaMod - - implicit none - - integer :: NTILES, N, I, k, command_argument_count, JPLH - integer, parameter :: nx = 8640, ny = 4320 - - character*400 :: BCSDIR, OUTDIR, GFILE, IMxJM, arg(5) - real, dimension (6) :: VGZ2 = (/35.0, 20.0, 17.0, 0.6, 0.5, 0.6/) ! Dorman and Sellers (1989) - logical :: file_exists - real, pointer, dimension (:) :: z2, z0, ityp - include 'netcdf.inc' - - I = command_argument_count() - IMxJM ='' - GFILE ='' - - if(command_argument_count() /= 5) then - print *, "Wrong Number of arguments: ", command_argument_count() - print *, "Usage : ./create_vegdyn_ndvi BCSDIR GFILE, IMxJM JPLH OUTDIR" - stop - endif - - do n=1,5 - call get_command_argument(n,arg(n)) - enddo - - read(arg(1),'(a)') BCSDIR - read(arg(2),'(a)') GFILE - read(arg(3),'(a)') IMxJM - read(arg(4),* ) JPLH - read(arg(5),'(a)') OUTDIR - - ! create dirs/links - ! ----------------- - - call execute_command_line('mkdir -p data ; cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') - call execute_command_line('mkdir -p '//trim(OUTDIR)) - - open (10,file = trim(BCSDIR)//'/clsm/catchment.def', & - form= 'formatted', action = 'read', status = 'old') - read (10,*) NTILES - close (10, status = 'keep') - - print '(a)', trim(BCSDIR)//'/'//trim(GFILE) - - allocate (ityp (1:NTILES)) - allocate (z2 (1:NTILES)) - - inquire(file=trim(BCSDIR)//'/vegdyn_'//trim(IMxJM)//'.dat',exist=file_exists) - if(file_exists) then - open (10,file = trim(BCSDIR)//'/vegdyn_'//trim(IMxJM)//'.dat',& - form= 'unformatted', action = 'read', status = 'old') - read (10) ityp - close (10) - else - print '(a)', 'MISSING VEGDYN FILE reading from mosaic_veg_typs_fracs' - open (10,file = trim(BCSDIR)//'/clsm/mosaic_veg_typs_fracs',& - form= 'formatted', action = 'read', status = 'old') - do n =1, ntiles - read (10, *) k,k,ityp(n) - end do - end if - - if(JPLH == 1) then - call jpl_canoph_this (ntiles, nx,ny,trim(BCSDIR)//'/rst/'//trim(GFILE), z2) - else - Z2 = VGZ2(NINT(ITYP)) - endif - - open (20,file=trim(OUTDIR)//'vegdyn_'//trim(IMxJM)//'.dat',status='unknown',action='write',form='unformatted', & - convert='little_endian') - - write (20) ityp - write (20) Z2 - - print *,'ITYP : ', minval(ityp), maxval (ityp) - print *,'Z2 : ', minval(z2 ), maxval (z2 ) - - call ascat_r0_this (ntiles, nx,ny,trim(BCSDIR)//'/rst/'//trim(GFILE), z0) - write (20) Z0 - - close (20, status = 'keep') - - print *,'Z0 : ', minval(z0 ), maxval (z0 ) - - call gimms_clim_ndvi (ntiles, nx,ny,trim(BCSDIR)//'/rst/'//trim(GFILE), trim(OUTDIR), trim(IMxJM)) -contains - - -! ----------------------------------------------------------------------------------- - - SUBROUTINE ascat_r0_this (ntiles, nc,nr,gfiler, z0) - - implicit none - - ! 1) ASCAT roughness - ! /discover/nobackup/adarmeno/projects/k14/arlems-roughness.x3600_y1800_t1.nc4 - - integer, intent (in) :: ntiles, nc, nr - real, pointer, dimension (:), intent (inout) :: z0 - character(*), intent (in) :: gfiler - integer , parameter :: N_lon_ascat = 3600, N_lat_ascat = 1800 - integer :: i,j, status, varid, ncid - integer :: tid, cid - REAL, ALLOCATABLE, dimension (:) :: count_pix - REAL, ALLOCATABLE, dimension (:,:) :: z0_grid, data_grid - INTEGER, ALLOCATABLE, dimension (:,:) :: tile_id - character*100 :: fout - - ! READ CLM4.5 source data files and regrid - ! ---------------------------------------- - - status = NF_OPEN ('data/CATCH/arlems-roughness.x3600_y1800_t1.nc4', NF_NOWRITE, ncid) - - allocate (z0_grid (1 : NC , 1 : NR)) - allocate (data_grid (1 : N_lon_ascat, 1 : N_lat_ascat)) - - status = NF_INQ_VARID (ncid,'roughness',VarID) ; VERIFY_(STATUS) - status = NF_GET_VARA_REAL (ncid,VarID, (/1,1,1/),(/N_lon_ascat, N_lat_ascat,1/), data_grid) ; VERIFY_(STATUS) - - call RegridRasterReal(data_grid, z0_grid) - - status = NF_CLOSE(ncid) - - ! Grid to tile - ! ------------ - - ! Reading tile-id raster file - - allocate(tile_id(1:nc,1:nr)) - - open (10,file=trim(gfiler)//'.rst',status='old',action='read', & - form='unformatted',convert='little_endian') - - do j=1,nr - read(10)tile_id(:,j) - end do - - close (10,status='keep') - - allocate (z0 (1:NTILES)) - allocate (count_pix (1:NTILES)) - - z0 = 0. - count_pix = 0. - - do j = 1,nr - do i = 1, nc - if((tile_id(i,j).gt.0).and.(tile_id(i,j).le.NTILES)) then - - ! z0 0. < 0.1 - if((z0_grid(i,j) >= 2.0e-6).and.(z0_grid(i,j) <= 0.1)) then - z0 (tile_id(i,j)) = z0 (tile_id(i,j)) + z0_grid(i,j) - count_pix (tile_id(i,j)) = count_pix (tile_id(i,j)) + 1. - endif - - endif - end do - end do - - where (count_pix > 0.) z0 = z0/count_pix - where (z0 == 0.) z0 = 2.0e-6 - - deallocate (count_pix) - deallocate (z0_grid) - deallocate (tile_id) - - END SUBROUTINE ascat_r0_this - ! ---------------------------------------------------------------------------------------------------------------------------- - - SUBROUTINE gimms_clim_ndvi (ntiles, nc,nr,gfiler, ThisDir, IMxJM) - - implicit none - ! Producing : GIMMS NDVI 15-day climatology from 5 arcmin data - ! 24 values per tile - - integer, intent (in) :: NTILES, nc, nr - character(*), intent (in) :: gfiler, ThisDir, IMxJM - integer , parameter :: N_lon_gimms = 4320, N_lat_gimms = 2160 - integer :: status, varid, ncid1, ncid2,ncid - real, dimension (:,:), allocatable :: ndvi_grid, data_grid - integer, dimension (:,:), allocatable ::data_grid2 - REAL, ALLOCATABLE, dimension (:) :: ndvi, count_pix - INTEGER, ALLOCATABLE, dimension (:,:) :: tile_id - integer :: yr,mn,yr1,mn1, k,t,i,j,l - integer, parameter :: scale_fac = 10000 - real, parameter :: val_min = -0.3, val_max = 1. - - ! Grid to tile - ! ------------ - - ! Reading tile-id raster file - - allocate(tile_id(1:nc,1:nr)) - - open (10,file=trim(gfiler)//'.rst',status='old',action='read', & - form='unformatted',convert='little_endian') - - do j=1,nr - read(10)tile_id(:,j) - end do - - close (10,status='keep') - - ! READ GIMMS NDVI source data files and regrid - ! ---------------------------------------- - - status = NF_OPEN ('data/CATCH/ndvi3g_geo_v1_YYYY_0106.nc4', NF_NOWRITE, ncid1) ; VERIFY_(STATUS) - status = NF_OPEN ('data/CATCH/ndvi3g_geo_v1_YYYY_0712.nc4', NF_NOWRITE, ncid2) ; VERIFY_(STATUS) - status = NF_INQ_VARID (ncid2,'ndvi',VarID) ; VERIFY_(STATUS) - - allocate (ndvi_grid (1:NC,1:NR)) - allocate (data_grid (1 : N_lon_gimms, 1 : N_lat_gimms)) - allocate (data_grid2(1 : N_lon_gimms, 1 : N_lat_gimms)) - allocate (ndvi (1:NTILES)) - allocate (count_pix (1:NTILES)) - - ! writing tile-spaced output - ! -------------------------- - - open (31,file=trim(ThisDir)//'ndvi_clim_'//trim(IMxJM)//'.data',status='unknown',action='write',form='unformatted', & - convert='little_endian') - - do K=0,13 - yr = (k+11)/12 - mn = mod(k+11,12)+1 - yr1= (k+12)/12 - mn1= mod(k+12,12)+1 - - ndvi = 0. - count_pix = 0. - t = k - if (k == 0 ) then - t = 12 - ncid = ncid2 - write(31) float((/yr,mn,16,0,0,0,yr1,mn1,1,0,0,0,NTILES,1/)) - - status = NF_GET_VARA_INT (ncid,VarID, (/1,1,t/),(/N_lon_gimms, N_lat_gimms,1/), data_grid2) ; VERIFY_(STATUS) - - do j = 1, N_lat_gimms - data_grid (:,j) = data_grid2 (:,N_lat_gimms - (j-1)) / real(scale_fac) - end do - - call RegridRasterReal(data_grid, ndvi_grid) - - do j = 1,nr - do i = 1, nc - if((tile_id(i,j).gt.0).and.(tile_id(i,j).le.NTILES)) then - if((ndvi_grid(i,j) >= val_min).and.(ndvi_grid(i,j) <= val_max)) then - ndvi (tile_id(i,j)) = ndvi (tile_id(i,j)) + ndvi_grid(i,j) - count_pix (tile_id(i,j)) = count_pix (tile_id(i,j)) + 1. - endif - endif - end do - end do - - where (count_pix > 0.) ndvi = ndvi /count_pix - write(31) ndvi - - elseif (k == 13) then - - t = 1 - ncid = ncid1 - write(31) float((/yr,mn,1,0,0,0,yr,mn,16,0,0,0,NTILES,1/)) - - status = NF_GET_VARA_INT (ncid,VarID, (/1,1,t/),(/N_lon_gimms, N_lat_gimms,1/), data_grid2) ; VERIFY_(STATUS) - - do j = 1, N_lat_gimms - data_grid (:,j) = data_grid2 (:,N_lat_gimms - (j-1)) / real(scale_fac) - end do - - call RegridRasterReal(data_grid, ndvi_grid) - - do j = 1,nr - do i = 1, nc - if((tile_id(i,j).gt.0).and.(tile_id(i,j).le.NTILES)) then - if((ndvi_grid(i,j) >= val_min).and.(ndvi_grid(i,j) <= val_max)) then - ndvi (tile_id(i,j)) = ndvi (tile_id(i,j)) + ndvi_grid(i,j) - count_pix (tile_id(i,j)) = count_pix (tile_id(i,j)) + 1. - endif - endif - end do - end do - - where (count_pix > 0.) ndvi = ndvi /count_pix - write(31) ndvi - - else - - do l = 1, 0 , -1 - t = k*2 - l - if (k <= 6) ncid = ncid1 - if (k >= 7) ncid = ncid2 - if (k >= 7) t = t - 12 - if(l == 1) write(31) float((/yr,mn,1,0,0,0,yr,mn,16,0,0,0,NTILES,1/)) - if(l == 0) write(31) float((/yr,mn,16,0,0,0,yr1,mn1,1,0,0,0,NTILES,1/)) - - ndvi = 0. - count_pix = 0. - - status = NF_GET_VARA_INT (ncid,VarID, (/1,1,t/),(/N_lon_gimms, N_lat_gimms,1/), data_grid2) ; VERIFY_(STATUS) - - do j = 1, N_lat_gimms - data_grid (:,j) = data_grid2 (:,N_lat_gimms - (j-1)) / real(scale_fac) - end do - - call RegridRasterReal(data_grid, ndvi_grid) - - do j = 1,nr - do i = 1, nc - if((tile_id(i,j).gt.0).and.(tile_id(i,j).le.NTILES)) then - if((ndvi_grid(i,j) >= val_min).and.(ndvi_grid(i,j) <= val_max)) then - ndvi (tile_id(i,j)) = ndvi (tile_id(i,j)) + ndvi_grid(i,j) - count_pix (tile_id(i,j)) = count_pix (tile_id(i,j)) + 1. - endif - endif - end do - end do - - where (count_pix > 0.) ndvi = ndvi /count_pix - write(31) ndvi - - end do - endif - end do - - close(31,status='keep') - - END SUBROUTINE gimms_clim_ndvi - - ! ---------------------------------------------------------------------------------------------------------------------------- - - SUBROUTINE jpl_canoph_this (ntiles, nc,nr,gfiler, z2) - - implicit none - - ! 1) JPL Canopy Height - ! /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001//Simard_Pinto_3DGlobalVeg_JGR.nc4 - - integer, intent (in) :: nc, nr, ntiles - real, pointer, dimension (:), intent (inout) :: z2 - character(*), intent (in) :: gfiler - integer , parameter :: N_lon_jpl = 43200, N_lat_jpl = 21600 - integer :: i,j, status, varid, ncid - REAL, ALLOCATABLE, dimension (:) :: count_pix - INTEGER, ALLOCATABLE, dimension (:,:) :: data_grid, z2_grid - INTEGER, ALLOCATABLE, dimension (:,:) :: tile_id - character*100 :: fout - - ! READ JPL source data files and regrid - ! ------------------------------------- - - status = NF_OPEN ('data/CATCH/Simard_Pinto_3DGlobalVeg_JGR.nc4', NF_NOWRITE, ncid) - - allocate (z2_grid (1 : NC , 1 : NR)) - allocate (data_grid (1 : N_lon_jpl, 1 : N_lat_jpl)) - - status = NF_INQ_VARID (ncid,'CanopyHeight',VarID) ; VERIFY_(STATUS) - status = NF_GET_VARA_INT (ncid,VarID, (/1,1/),(/N_lon_jpl, N_lat_jpl/), data_grid) ; VERIFY_(STATUS) - - call RegridRaster(data_grid, z2_grid) - - status = NF_CLOSE(ncid) - - ! Grid to tile - ! ------------ - - ! Reading tile-id raster file - - allocate(tile_id(1:nc,1:nr)) - - open (10,file=trim(gfiler)//'.rst',status='old',action='read', & - form='unformatted',convert='little_endian') - - do j=1,nr - read(10)tile_id(:,j) - end do - - close (10,status='keep') - - if(.not.associated(z2)) allocate (z2 (1:NTILES)) - allocate (count_pix (1:NTILES)) - - z2 = 0. - count_pix = 0. - - do j = 1,nr - do i = 1, nc - if((tile_id(i,j).gt.0).and.(tile_id(i,j).le.NTILES)) then - - if(z2_grid(i,j) >= 0.) then - z2 (tile_id(i,j)) = z2 (tile_id(i,j)) + real (z2_grid(i,j)) - count_pix (tile_id(i,j)) = count_pix (tile_id(i,j)) + 1. - endif - - endif - end do - end do - - where (count_pix > 0.) z2 = z2/count_pix - where (z2 < 0.01) z2 = 0.01 ! to ensure Z2 >= MIN_VEG_HEIGHT - - deallocate (count_pix) - deallocate (z2_grid) - deallocate (tile_id) - - END SUBROUTINE jpl_canoph_this - -!-------------------------------------- - - END PROGRAM create_vegdyn_ndvi diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/leap_year.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/leap_year.F90 deleted file mode 100644 index 5382a570f..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/leap_year.F90 +++ /dev/null @@ -1,95 +0,0 @@ - -module leap_year - - implicit none - -contains - - integer function days_in_month(year, month) - - ! return the number of days in a given month - - implicit none - - integer :: year, month - - integer, dimension(12), parameter :: days_in_month_leap = & - (/ 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) - - integer, dimension(12), parameter :: days_in_month_nonleap = & - (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) - - if (is_leap_year(year)) then - days_in_month = days_in_month_leap(month) - else - days_in_month = days_in_month_nonleap(month) - end if - - end function days_in_month - - ! ------------------------------------------------------------------ - - integer function days_in_year(year) - - ! return the number of days in a given year - - implicit none - - integer :: year - - if (is_leap_year(year)) then - days_in_year = 366 - else - days_in_year = 365 - end if - - end function days_in_year - - ! ------------------------------------------------------------------ - - logical function is_leap_year(year) - - implicit none - - integer :: year - - if (mod(year,4) /= 0) then - is_leap_year = .false. - else if (mod(year,400) == 0) then - is_leap_year = .true. - else if (mod(year,100) == 0) then - is_leap_year = .false. - else - is_leap_year = .true. - end if - - end function is_leap_year - - ! ------------------------------------------------------------------ - - integer function pentad_of_year(day_of_year, year) - - implicit none - - integer :: day_of_year, year - - ! determine pentad - - if ((is_leap_year(year)) .and. day_of_year>=59) then - - pentad_of_year = (day_of_year-2)/5+1 - - else - - pentad_of_year = (day_of_year-1)/5+1 - - end if - - end function pentad_of_year - -end module leap_year - - -! ========= EOF ========================================================= - - 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 new file mode 100755 index 000000000..6d7b0328e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt @@ -0,0 +1,49 @@ +esma_set_this() + +set (srcs +LDAS_DateTimeMod.F90 +EASE_conv.F90 +mod_process_hres_data.F90 +rasterize.F90 +read_riveroutlet.F90 +CubedSphere_GridMod.F90 +rmTinyCatchParaMod.F90 +zip.c +util.c +) + +if(NOT FORTRAN_COMPILER_SUPPORTS_FINDLOC) + list(APPEND srcs findloc.F90) +endif () + +set_source_files_properties(mkMITAquaRaster.F90 PROPERTIES COMPILE_FLAGS "${BYTERECLEN}") + +esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran OpenMP::OpenMP_C) + +if(NOT FORTRAN_COMPILER_SUPPORTS_FINDLOC) + target_compile_definitions(${this} PRIVATE USE_EXTERNAL_FINDLOC) +endif () + +# MAT NOTE This should use find_package(ZLIB) but Baselibs currently +# confuses find_package(). This is a hack until Baselibs is +# reorganized. +if (Baselibs_FOUND) + set (INC_ZLIB ${BASEDIR}/include/zlib) + target_include_directories(${this} PRIVATE ${INC_ZLIB}) +else () + find_package(ZLIB) + target_link_libraries(${this} PRIVATE ZLIB::zlib) +endif () + +ecbuild_add_executable (TARGET CombineRasters.x SOURCES CombineRasters.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET mkCatchParam.x SOURCES mkCatchParam.F90 LIBS MAPL ${this} OpenMP::OpenMP_Fortran) +ecbuild_add_executable (TARGET mkCubeFVRaster.x SOURCES mkCubeFVRaster.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET mkLandRaster.x SOURCES mkLandRaster.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET mkLatLonRaster.x SOURCES mkLatLonRaster.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET mkMITAquaRaster.x SOURCES mkMITAquaRaster.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET mkMOMAquaRaster.x SOURCES mkMOMAquaRaster.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET FillMomGrid.x SOURCES FillMomGrid.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET mk_runofftbl.x SOURCES mk_runofftbl.F90 LIBS MAPL ${this}) +ecbuild_add_executable (TARGET mkEASETilesParam.x SOURCES mkEASETilesParam.F90 LIBS MAPL ${this}) + +install(PROGRAMS make_bcs clsm_plots.pro create_README.csh DESTINATION bin) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CombineRasters.F90 similarity index 96% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CombineRasters.F90 index a5ba74ffc..3c3605c27 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CombineRasters.F90 @@ -1,12 +1,13 @@ -! $Id: - -#include "Raster.h" +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program mkOverlaySimple use LogRectRasterizeMod use MAPL_SortMod use MAPL_HashMod + use MAPL_ExceptionHandling + use MAPL_Constants ! Overlay atmosphere, land, and ocean rasters, creating a .idx file. ! The ocean raster should be defined everywhere, or at least, everywhere @@ -27,7 +28,7 @@ program mkOverlaySimple integer, parameter :: TILUNIT1 = 22 integer, parameter :: TILUNIT2 = 23 - REAL_, parameter :: PI = RASTER_PI + real(kind=8), parameter :: PI = MAPL_PI_R8 integer :: command_argument_count integer :: nxt, argl, fill @@ -42,12 +43,12 @@ program mkOverlaySimple integer, allocatable :: RST2(: ) integer, allocatable :: iTable(:,:) - REAL_ , allocatable :: Table1(:,:) - REAL_ , allocatable :: Table2(:,:) - REAL_ , allocatable :: rTable(:,:) - REAL_ , allocatable :: cc(:), ss(:) - REAL_ :: dx, dy, area, xc, yc, d2r, vv(4) - REAL_ :: lats, lons, da + real(kind=8) , allocatable :: Table1(:,:) + real(kind=8) , allocatable :: Table2(:,:) + real(kind=8) , allocatable :: rTable(:,:) + real(kind=8) , allocatable :: cc(:), ss(:) + real(kind=8) :: dx, dy, area, xc, yc, d2r, vv(4) + real(kind=8) :: lats, lons, da logical :: DoZip logical :: Verb @@ -64,6 +65,7 @@ program mkOverlaySimple character*128 :: & Usage = "CombineRasters -v -h -z -t MT -g GF -f TYPE BOTTOMRASTER TOPRASTER" + character*128 :: Iam = "CombineRasters" integer :: Pix1, Pix2 ! Argument defaults diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CubedSphere_GridMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CubedSphere_GridMod.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CubedSphere_GridMod.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CubedSphere_GridMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/EASE_conv.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/EASE_conv.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/EASE_conv.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/EASE_conv.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/FillMomGrid.F90 similarity index 99% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/FillMomGrid.F90 index 3b596641f..36dbc1921 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/FillMomGrid.F90 @@ -1,4 +1,3 @@ -!#include "Raster.h" #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 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/date_time_util.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/LDAS_DateTimeMod.F90 similarity index 61% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/date_time_util.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/LDAS_DateTimeMod.F90 index 9876e7236..8799ad792 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/date_time_util.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/LDAS_DateTimeMod.F90 @@ -1,7 +1,5 @@ -module date_time_util - - use leap_year +module LDAS_DateTimeMod implicit none @@ -10,6 +8,9 @@ module date_time_util private public :: date_time_type + public :: date_time_print + public :: is_leap_year + public :: days_in_month public :: get_dofyr_pentad public :: augment_date_time public :: datetime2_minus_datetime1 @@ -17,6 +18,8 @@ module date_time_util public :: datetime_le_refdatetime public :: datetime_lt_refdatetime public :: date_time2string + public :: datetime_to_J2000seconds + public :: J2000seconds_to_datetime ! --------------------------------------------------------------------- @@ -39,10 +42,106 @@ module date_time_util integer :: pentad ! pentad of year integer :: dofyr ! day of year end type date_time_type - + contains - ! ********************************************************** + + function date_time_print(dt) result (dtstr) + + implicit none + + type(date_time_type), intent(in) :: dt + character(len=19) :: dtstr ! output + + write(dtstr,298) dt%year, dt%month, dt%day, dt%hour, dt%min, dt%sec +298 format(i4.4,'-',i2.2,'-',i2.2,'T',i2.2,':',i2.2,':',i2.2) + + end function date_time_print + ! ********************************************************** + + integer function days_in_month(year, month) + + ! return the number of days in a given month + + implicit none + + integer :: year, month + + integer, dimension(12), parameter :: days_in_month_leap = & + (/ 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) + + integer, dimension(12), parameter :: days_in_month_nonleap = & + (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) + + if (is_leap_year(year)) then + days_in_month = days_in_month_leap(month) + else + days_in_month = days_in_month_nonleap(month) + end if + + end function days_in_month + + ! ------------------------------------------------------------------ + + integer function days_in_year(year) + + ! return the number of days in a given year + + implicit none + + integer :: year + + if (is_leap_year(year)) then + days_in_year = 366 + else + days_in_year = 365 + end if + + end function days_in_year + + ! ------------------------------------------------------------------ + + logical function is_leap_year(year) + + implicit none + + integer :: year + + if (mod(year,4) /= 0) then + is_leap_year = .false. + else if (mod(year,400) == 0) then + is_leap_year = .true. + else if (mod(year,100) == 0) then + is_leap_year = .false. + else + is_leap_year = .true. + end if + + end function is_leap_year + + ! ------------------------------------------------------------------ + + integer function pentad_of_year(day_of_year, year) + + implicit none + + integer :: day_of_year, year + + ! determine pentad + + if ((is_leap_year(year)) .and. day_of_year>=59) then + + pentad_of_year = (day_of_year-2)/5+1 + + else + + pentad_of_year = (day_of_year-1)/5+1 + + end if + + end function pentad_of_year + + ! ------------------------------------------------------------------ subroutine get_dofyr_pentad( date_time ) @@ -254,12 +353,14 @@ integer function datetime2_minus_datetime1( d1, d2 ) type(date_time_type) :: de, dl - integer :: fac, secs, tmpint, y, secs_in_year_de, secs_in_year_dl + integer :: fac, secs, y, secs_in_year_de, secs_in_year_dl ! ------------------------------------------------------------------- ! ! make sure type integer is not out of range - + ! + ! [integer*4 only allows for differences of up to ~68 years] + if ( (abs(d2%year-d1%year)+1) > ((huge(secs)/86400)/366) ) then write (*,*) 'datetime2_minus_datetime1(): integer out of range.' @@ -485,10 +586,8 @@ end function datetime2_gt_eq_lt_datetime1 character(16) function date_time2string( date_time ) - ! Generates a string from date_time structure (ignore seconds) - - !!use driver_types - + ! Generate "YYYYMMDD_HHMMSSz" string from date_time structure + implicit none type(date_time_type) :: date_time @@ -498,22 +597,169 @@ character(16) function date_time2string( date_time ) character(2) :: char_day character(2) :: char_hour character(2) :: char_min + character(2) :: char_sec write(char_year, '(i4.4)') date_time%year write(char_month, '(i2.2)') date_time%month write(char_day, '(i2.2)') date_time%day write(char_hour, '(i2.2)') date_time%hour write(char_min, '(i2.2)') date_time%min + write(char_sec, '(i2.2)') date_time%sec - date_time2string = char_year // '.' // char_month // '.' & - // char_day // '.' // char_hour // '.' // char_min + date_time2string = char_year // char_month // char_day // '_' & + // char_hour // char_min // char_sec // 'z' end function date_time2string ! ******************************************************************** -end module date_time_util + real*8 function datetime_to_J2000seconds( date_time, epoch_id ) + + ! reichle, 14 Jan 2014 + + implicit none + + type(date_time_type) :: date_time + + character(4) :: epoch_id + + integer :: tmp_secs + + ! -------------------------------------------- + + ! get integer seconds + + tmp_secs = datetime2_minus_datetime1( J2000_epoch(epoch_id), date_time ) + + ! convert to double precision floating point value + + datetime_to_J2000seconds = real(tmp_secs,kind(0.0D0)) + + ! correct for 0.816 milliseconds (if using "UT12" definition of J2000 Epoch) + + if (epoch_id=='UT12') datetime_to_J2000seconds = datetime_to_J2000seconds - 0.816D0 + + end function datetime_to_J2000seconds + + ! ******************************************************************** + + type(date_time_type) function J2000seconds_to_datetime( J2000_seconds, epoch_id ) + + ! reichle, 14 Jan 2014 + + implicit none + + real*8 :: J2000_seconds + + type(date_time_type) :: date_time + + character(4) :: epoch_id + + integer :: tmp_secs + + ! -------------------------------------------- + + date_time = J2000_epoch( epoch_id ) + + tmp_secs = nint(J2000_seconds) + + if ( J2000_seconds > real(huge(tmp_secs),kind(0.0D0)) ) then + + write (*,*) 'J2000seconds_to_datetime(): J2000_seconds out of range.' + write (*,*) 'STOPPING.' + stop + + end if + + call augment_date_time( tmp_secs, date_time ) + + J2000seconds_to_datetime = date_time + + end function J2000seconds_to_datetime + + ! ******************************************************************** + + type(date_time_type) function J2000_epoch( epoch_id ) + + ! reichle, 30 Jun 2015 + + implicit none + + character(4) :: epoch_id + + character(len=*), parameter :: Iam = 'J2000_epoch' + + ! ------------------------------------- + ! + ! definition of J2000 epochs + ! + ! "J2000 seconds" are elapsed seconds since J2000 Epoch, which is either + ! + ! - "UT12": 11:58:55.816 on 1 Jan 2000 in Coordinated Universal Time (UTC), or + ! - "TT12": 12:00:00.000 on 1 Jan 2000 in Terrestrial Time (TT), or + ! - "UT00": 00:00:00.000 on 1 Jan 2000 in Coordinated Universal Time (UTC) + ! + ! NOTE: Per SMAP L1C_TB data products specs document, SMAP time stamps use "UT12" + ! but sample granules appear to be using "TT12". + ! NOTE: Per Clara Draper (30 Jun 2015), the nc4 ASCAT soil moisture retrieval + ! product uses "UT00". + + type(date_time_type), parameter :: J2000_UT12 = date_time_type( & + year = 2000, & + month = 1, & + day = 1, & + hour = 11, & + min = 58, & + sec = 55, & ! rounded down + pentad = 1, & + dofyr = 1 ) + + type(date_time_type), parameter :: J2000_TT12 = date_time_type( & + year = 2000, & + month = 1, & + day = 1, & + hour = 12, & + min = 0, & + sec = 0, & + pentad = 1, & + dofyr = 1 ) + + type(date_time_type), parameter :: J2000_UT00 = date_time_type( & + year = 2000, & + month = 1, & + day = 1, & + hour = 0, & + min = 0, & + sec = 0, & + pentad = 1, & + dofyr = 1 ) + + ! ---------------------------- + + select case (epoch_id) + + case ('UT12') + J2000_epoch = J2000_UT12 + + case ('TT12') + J2000_epoch = J2000_TT12 + + case ('UT00') + J2000_epoch = J2000_UT00 + + case default + + write (*,*) Iam // ' unknown J2000 epoch_id' + write (*,*) 'STOPPING.' + stop + + end select + + end function J2000_epoch + + ! ******************************************************************** +end module LDAS_DateTimeMod ! ****************************************************************** @@ -523,14 +769,19 @@ end module date_time_util program test - use date_time_util + use LDAS_DateTimeMod implicit none - type(date_time_type) :: start_time, end_time + type(date_time_type) :: start_time, end_time, date_time, date_time_tmp integer :: diff + real*8 :: J2000_seconds = -987303600.0D0 + + character(4) :: J2000_epoch_id + + start_time%year = 1992 ! 4-digit year start_time%month = 11 ! month in year start_time%day = 1 ! day in month @@ -540,21 +791,31 @@ program test start_time%pentad = -9999 ! pentad of year start_time%dofyr = -9999 ! day of year - - end_time%year = 1998 ! 4-digit year - end_time%month = 11 ! month in year - end_time%day = 3 ! day in month - end_time%hour = 0 ! hour of day - end_time%min = 0 ! minute of hour - end_time%sec = 0 ! seconds of minute + end_time%year = 2000 ! 4-digit year + end_time%month = 1 ! month in year + end_time%day = 1 ! day in month + end_time%hour = 11 ! hour of day + end_time%min = 58 ! minute of hour + end_time%sec = 55 ! seconds of minute end_time%pentad = -9999 ! pentad of year end_time%dofyr = -9999 ! day of year + date_time%year = 2014 ! 4-digit year + date_time%month = 1 ! month in year + date_time%day = 14 ! day in month + date_time%hour = 12 ! hour of day + date_time%min = 34 ! minute of hour + date_time%sec = 56 ! seconds of minute + date_time%pentad = -9999 ! pentad of year + date_time%dofyr = -9999 ! day of year + + write (*,*) huge(diff) call get_dofyr_pentad( start_time ) call get_dofyr_pentad( end_time ) + call get_dofyr_pentad( date_time ) write (*,*) start_time write (*,*) end_time @@ -605,7 +866,51 @@ program test write (*,*) start_time + ! ------------------------------ + + J2000_epoch_id = 'UT12' + + write (*,*) '-------------------------------' + + write (*,*) 'J2000_epoch_id = ', J2000_epoch_id + + write (*,*) '-------------------------------' + write (*,*) start_time + write (*,*) datetime_to_J2000seconds( start_time, J2000_epoch_id ) + write (*,*) '-------------------------------' + write (*,*) end_time + write (*,*) datetime_to_J2000seconds( end_time, J2000_epoch_id ) + write (*,*) '-------------------------------' + write (*,*) date_time + write (*,*) datetime_to_J2000seconds( date_time, J2000_epoch_id ) + write (*,*) '-------------------------------' + + ! ------------------------------ + + date_time_tmp = end_time + + write (*,*) end_time + write (*,*) date_time_tmp + write (*,*) date_time + + diff = datetime2_minus_datetime1( end_time, date_time ) + + write (*,*) diff + write (*,*) datetime_to_J2000seconds( date_time, J2000_epoch_id ) + + call augment_date_time( diff, date_time_tmp ) + + write (*,*) date_time_tmp + ! ---------------------------------- + + write (*,*) '-------------------------------' + write (*,*) J2000_seconds + + write (*,*) J2000seconds_to_datetime( J2000_seconds, J2000_epoch_id ) + write (*,*) '-------------------------------' + + end program test #endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/bcs_utils.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/bcs_utils.py similarity index 97% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/bcs_utils.py rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/bcs_utils.py index 59e8fce6a..2e70bdbd5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/bcs_utils.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/bcs_utils.py @@ -42,24 +42,24 @@ def get_config_from_answers(answers): hostname = socket.gethostname() input_dir = '' if 'discover' in hostname: - input_dir = '/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/' + input_dir = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/' else: input_dir = '/nobackup/gmao_SIteam/ModelData/l_data/LandBCs_files_for_mkCatchParam/V001/' maskfile = '' if orslvs in['O1','T2','T3','T4','T1MOM6','T2MOM6','T4MOM6']: - maskfile = 'GEOS5_10arcsec_mask_freshwater-lakes.nc' + maskfile = 'shared/mask/GEOS5_10arcsec_mask_freshwater-lakes.nc' if lbcsv in ['F25', 'GM4', 'ICA']: maskfile = 'global.cat_id.catch.DL' if orslvs in['O2','O3','CS']: - maskfile = 'GEOS5_10arcsec_mask.nc' + maskfile = 'shared/mask/GEOS5_10arcsec_mask.nc' if lbcsv in ['F25', 'GM4', 'ICA']: maskfile = 'global.cat_id.catch.GreatLakesCaspian_Updated.DL' if grid_type in ['EASEv1', 'EASEv2']: - maskfile = 'GEOS5_10arcsec_mask.nc' + maskfile = 'shared/mask/GEOS5_10arcsec_mask.nc' imo['O1'] = 360 jmo['O1'] = 180 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/clsm_plots.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/clsm_plots.pro similarity index 94% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/clsm_plots.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/clsm_plots.pro index cfb19b470..34617862b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/clsm_plots.pro +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/clsm_plots.pro @@ -347,8 +347,6 @@ clm_file = '../CLM_veg_typs_fracs' if (file_test (clm_file)) then begin -;spawn, "/bin/cp /discover/nobackup/smahanam/GEOS5_misc/mask/images/ESA_LandCover_mask.jpg ." - plot_clm , ncat, tile_id plot_carbon, ncat, tile_id @@ -1681,7 +1679,7 @@ end PRO canop_Height, nc, nr, tileid_plot, gfile, path -CanopH=read_tiff(path + '/data/CATCH/Simard_Pinto_3DGlobalVeg_JGR.tif') +CanopH=read_tiff('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/veg/veg_height/v1/Simard_Pinto_3DGlobalVeg_JGR.tif') im=n_elements(CanopH(*,0)) jm=n_elements(CanopH(0,*)) CanopH = reverse(CanopH,2,/overwrite) @@ -2084,7 +2082,7 @@ nr_esa = 64800l nx = nc_esa/nc ny = nr_esa/nr -ncid = NCDF_OPEN('/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/GEOS5_10arcsec_mask.nc') +ncid = NCDF_OPEN('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/shared/mask/GEOS5_10arcsec_mask.nc') ;NCDF_VARGET, ncid,0, y ;NCDF_VARGET, ncid,1, x @@ -2501,7 +2499,7 @@ end pro jpl_tif2nc4 -CanopH=read_tiff('/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001//Simard_Pinto_3DGlobalVeg_JGR.tif') +CanopH=read_tiff('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/veg/veg_height/v1/Simard_Pinto_3DGlobalVeg_JGR.tif') im=n_elements(CanopH(*,0)) jm=n_elements(CanopH(0,*)) CanopH = reverse(CanopH,2,/overwrite) @@ -2511,11 +2509,11 @@ for i = 0l,jm -1l do yh(i) = i*1./120 -90. + 1./240. xh = dblarr(im) for i = 0l,im -1l do xh(i) = i*1./120 -180. + 1./240. -id = NCDF_CREATE('/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001//Simard_Pinto_3DGlobalVeg_JGR.nc4', /clobber, /NETCDF4_FORMAT) +id = NCDF_CREATE('/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/veg/veg_height/v1/Simard_Pinto_3DGlobalVeg_JGR.nc4', /clobber, /NETCDF4_FORMAT) xid = NCDF_DIMDEF(id, 'N_lon' , im) ;Define x-dimension yid = NCDF_DIMDEF(id, 'N_lat' , jm) ;Define y-dimension -NCDF_ATTPUT,id, 'CreatedBy', 'Sarith Mahanama GMAO/GSFC/NASA',/global -NCDF_ATTPUT,id, 'Contact', 'sarith.p.mahanama@nasa.gov',/global +NCDF_ATTPUT,id, 'CreatedBy', 'NASA GSFC GMAO Land Group',/global +NCDF_ATTPUT,id, 'Contact', 'NASA GSFC GMAO Land Group',/global str_date=systime() NCDF_ATTPUT,id, 'Date', str_date,/global @@ -2924,175 +2922,178 @@ end ; ------------------------------------ -pro proc_glass - - -;IDATA = '/gpfsm/dnb43/projects/p03/RS_DATA/GLASS/LAI/AVHRR/V4/HDF/' -;ODATA = '/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/GLASS-LAI/AVHRR.v4/' -;LABEL = 'GLASS01B02.V04.A' -;yearb = 1981 +;; This program is being deprecated, we don't have IDATA valid path +;pro proc_glass +; +; +;;IDATA = '/gpfsm/dnb43/projects/p03/RS_DATA/GLASS/LAI/AVHRR/V4/HDF/' +;;ODATA = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/veg/lai_grn/v4/GLASS-LAI/AVHRR.v4/' +;;LABEL = 'GLASS01B02.V04.A' +;;yearb = 1981 +;;YEARe = 2017 +; +;IDATA = '/gpfsm/dnb43/projects/p03/RS_DATA/GLASS/LAI/MODIS/V4/HDF/' +;ODATA = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/veg/lai_grn/v4/GLASS-LAI/MODIS.v4/' +;LABEL = 'GLASS01B01.V04.A' +;yearb = 2000 ;YEARe = 2017 +; +;nc = 7200 +;nr = 3600 +;nyrs = YEARe - yearb + 1 +; +;lwval = 0. +;upval = 7. +; +;im = nc +;jm = nr +; +;dx = 360. / im +;dy = 180. / jm +; +;x = indgen(im)*dx -180. + dx/2. +;y = indgen(jm)*dy -90. + dy/2. +;r_in = [253,224,255,238,205,193,152, 0,124, 0, 0, 0, 0, 0, 0, 48,110, 85] +;g_in = [253,238,255,238,205,255,251,255,252,255,238,205,139,128,100,128,139,107] +;b_in = [253,224, 0, 0, 0,193,152,127, 0, 0, 0, 0, 0, 0, 0, 20, 61, 47] +; +;n_levels = n_elements (r_in) +;levels=[0.,0.25,0.5,0.75,1.,1.25,1.5,10. * indgen(11)*0.05+2.] +;red = intarr (256) +;green= intarr (256) +;blue = intarr (256) +; +;red (255) = 255 +;green(255) = 255 +;blue (255) = 255 +; +;for k = 0, N_levels -1 do begin +; red (k+1) = r_in (k) +; green(k+1) = g_in (k) +; blue (k+1) = b_in (k) +;endfor +;thisDevice = !D.Name +;set_plot,'Z' +;Device, Set_Resolution=[800,500], Z_Buffer=0 +;TVLCT,red,green,blue +;colors = indgen (N_levels) + 1 +; +;limits = [-60,-180,90,180] +; +;Erase,255 +;!p.background = 255 +; +;;file1 = '/gpfsm/dnb43/projects/p03/RS_DATA/GLASS/LAI/MODIS/V4/HDF/2008/GLASS01B01.V04.A2008185.hdf' +;file1 = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/veg/lai_grn/v4/GLASS-LAI/MODIS.v4/GLASS01B01.V04.AYYYY105.nc4' +;ncid = ncdf_open (file1) +;NCDF_VARGET, ncid,'LAI', adum +;ncdf_close,ncid +; +;;FileID=HDF_SD_Start(file1, /read) +;;sds_id = hdf_sd_select(FileID, 0) +;;hdf_sd_getdata, sds_id,adum +;;HDF_SD_END, FileID +;adum (where (adum eq 2550)) = !VALUES.F_NAN +;adum = adum /100. +; +; +;MAP_SET,/CYLINDRICAL,/hires,color= 0,/NoErase,limit=limits +;MAP_CONTINENTS,/COASTS,color=0,MLINETHICK=2,/USA +;;contour, adum,x,y,levels = levels,c_colors=colors,/cell_fill +; +;snapshot = TVRD() +;TVLCT, r, g, b, /Get +;Device, Z_Buffer=1 +;Set_Plot, thisDevice +;image24 = BytArr(3, 800, 500) +;image24[0,*,*] = r[snapshot] +;image24[1,*,*] = g[snapshot] +;image24[2,*,*] = b[snapshot] +;Write_JPEG, 'global_map.jpg', image24, True=1, Quality=100 +;stop +; +;for DOY = 1,361,8 do begin +; LAI = intarr (nc,nr,nyrs) +; LAI (*,*,*) = 2550 +; DDD = string (DOY,'(i3.3)') +; for year = yearB, yearE do begin +; YYYY = string (year, '(i4.4)') +; filename = IDATA + YYYY + '/' + LABEL + yyyy + DDD + '.hdf' +; FileID=HDF_SD_Start(filename, /read) +; sds_id = hdf_sd_select(FileID, 0) +; hdf_sd_getdata, sds_id,adum +; adum = adum *10 +; HDF_SD_END, FileID +; print, year,min(adum), max(adum) +; LAI (*,*,year - yearB) = adum +; +; endfor +; +;indata = intarr (nc,nr) +;indata (*,*) = 2550 +; +;for j = 0, nr -1 do begin +; for i = 0, nc -1 do begin +; if(min (LAI (i,j,*)) lt 2550) then begin +; syears = where (LAI (i,j,*) lt 2550) +; indata (i,j) = mean (LAI (i,j,syears)) +; ; if(mean (LAI (i,j,syears)) gt 500.) then stop +; ; print, n_elements (syears), mean (LAI (i,j,syears)) +; endif +; endfor +;endfor +; +;print, min (indata), max(indata) +; +;ofile = ODATA + LABEL + 'YYYY' + DDD + '.nc4' +;write_glass_output, indata, ofile +; +;endfor +; +;end +; +;; ---------------------------------------------------------------- +; +; +;; This program is being deprecated, since it needs "pro proc_glass" -IDATA = '/gpfsm/dnb43/projects/p03/RS_DATA/GLASS/LAI/MODIS/V4/HDF/' -ODATA = '/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/GLASS-LAI/MODIS.v4/' -LABEL = 'GLASS01B01.V04.A' -yearb = 2000 -YEARe = 2017 - -nc = 7200 -nr = 3600 -nyrs = YEARe - yearb + 1 - -lwval = 0. -upval = 7. - -im = nc -jm = nr - -dx = 360. / im -dy = 180. / jm - -x = indgen(im)*dx -180. + dx/2. -y = indgen(jm)*dy -90. + dy/2. -r_in = [253,224,255,238,205,193,152, 0,124, 0, 0, 0, 0, 0, 0, 48,110, 85] -g_in = [253,238,255,238,205,255,251,255,252,255,238,205,139,128,100,128,139,107] -b_in = [253,224, 0, 0, 0,193,152,127, 0, 0, 0, 0, 0, 0, 0, 20, 61, 47] - -n_levels = n_elements (r_in) -levels=[0.,0.25,0.5,0.75,1.,1.25,1.5,10. * indgen(11)*0.05+2.] -red = intarr (256) -green= intarr (256) -blue = intarr (256) - -red (255) = 255 -green(255) = 255 -blue (255) = 255 - -for k = 0, N_levels -1 do begin - red (k+1) = r_in (k) - green(k+1) = g_in (k) - blue (k+1) = b_in (k) -endfor -thisDevice = !D.Name -set_plot,'Z' -Device, Set_Resolution=[800,500], Z_Buffer=0 -TVLCT,red,green,blue -colors = indgen (N_levels) + 1 - -limits = [-60,-180,90,180] - -Erase,255 -!p.background = 255 - -;file1 = '/gpfsm/dnb43/projects/p03/RS_DATA/GLASS/LAI/MODIS/V4/HDF/2008/GLASS01B01.V04.A2008185.hdf' -file1 = '/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/GLASS-LAI/MODIS.v4/GLASS01B01.V04.AYYYY105.nc4' -ncid = ncdf_open (file1) -NCDF_VARGET, ncid,'LAI', adum -ncdf_close,ncid - -;FileID=HDF_SD_Start(file1, /read) -;sds_id = hdf_sd_select(FileID, 0) -;hdf_sd_getdata, sds_id,adum -;HDF_SD_END, FileID -adum (where (adum eq 2550)) = !VALUES.F_NAN -adum = adum /100. - - -MAP_SET,/CYLINDRICAL,/hires,color= 0,/NoErase,limit=limits -MAP_CONTINENTS,/COASTS,color=0,MLINETHICK=2,/USA -;contour, adum,x,y,levels = levels,c_colors=colors,/cell_fill - -snapshot = TVRD() -TVLCT, r, g, b, /Get -Device, Z_Buffer=1 -Set_Plot, thisDevice -image24 = BytArr(3, 800, 500) -image24[0,*,*] = r[snapshot] -image24[1,*,*] = g[snapshot] -image24[2,*,*] = b[snapshot] -Write_JPEG, 'global_map.jpg', image24, True=1, Quality=100 -stop - -for DOY = 1,361,8 do begin - LAI = intarr (nc,nr,nyrs) - LAI (*,*,*) = 2550 - DDD = string (DOY,'(i3.3)') - for year = yearB, yearE do begin - YYYY = string (year, '(i4.4)') - filename = IDATA + YYYY + '/' + LABEL + yyyy + DDD + '.hdf' - FileID=HDF_SD_Start(filename, /read) - sds_id = hdf_sd_select(FileID, 0) - hdf_sd_getdata, sds_id,adum - adum = adum *10 - HDF_SD_END, FileID - print, year,min(adum), max(adum) - LAI (*,*,year - yearB) = adum - - endfor - -indata = intarr (nc,nr) -indata (*,*) = 2550 - -for j = 0, nr -1 do begin - for i = 0, nc -1 do begin - if(min (LAI (i,j,*)) lt 2550) then begin - syears = where (LAI (i,j,*) lt 2550) - indata (i,j) = mean (LAI (i,j,syears)) - ; if(mean (LAI (i,j,syears)) gt 500.) then stop - ; print, n_elements (syears), mean (LAI (i,j,syears)) - endif - endfor -endfor - -print, min (indata), max(indata) - -ofile = ODATA + LABEL + 'YYYY' + DDD + '.nc4' -write_glass_output, indata, ofile - -endfor - -end - -; ---------------------------------------------------------------- - - -pro write_glass_output,indata,ofile - -nc = 7200 -nr = 3600 - -id = NCDF_CREATE(ofile, /clobber) ;Create netCDF output file -xid = NCDF_DIMDEF(id, 'N_lon', nc) ;Define x-dimension -yid = NCDF_DIMDEF(id, 'N_lat', nr) ;Define y-dimension -NCDF_ATTPUT,id, 'CellSize_arcmin' , 3,/global -NCDF_ATTPUT,id, 'CreatedBy', 'Sarith Mahanama',/global -NCDF_ATTPUT,id, 'Contact', 'sarith.p.mahanama@nasa.gov',/global -str_date=systime() -NCDF_ATTPUT,id, 'Date', str_date,/global -vid = NCDF_VARDEF(id, 'lat', yid, /DOUBLE) ;Define latitude variable -vid = NCDF_VARDEF(id, 'lon', xid, /DOUBLE) ;Define longitude variable -vid = NCDF_VARDEF(id, 'LAI', [xid, yid], /SHORT) -NCDF_ATTPUT, id, vid, 'LongName','Leaf Area Index 8-Day 0.05-degrees GEO Grid climatology' -NCDF_ATTPUT, id, vid, 'units', 'm^2/m^2' -NCDF_ATTPUT, id, vid, 'scale_factor',0.01 -NCDF_ATTPUT, id, vid, 'valid_range','0 1000' -NCDF_ATTPUT, id, vid, '_FillValue', 2550 - -NCDF_CONTROL, id, /ENDEF - -dxy = 360.d/7200.d - -x = indgen (nc)*dxy -180. + dxy/2.d -y = indgen (nr)*dxy -90. + dxy/2.d - -NCDF_VARPUT, id,'lat', y -NCDF_VARPUT, id,'lon', x -for j =0, nr -1 do begin -NCDF_VARPUT, id, 'LAI',offset=[0,nr-1 -j],count=[nc,1] , nint(indata [*,j]) -endfor -NCDF_CLOSE, id - -end +;pro write_glass_output,indata,ofile +; +;nc = 7200 +;nr = 3600 +; +;id = NCDF_CREATE(ofile, /clobber) ;Create netCDF output file +;xid = NCDF_DIMDEF(id, 'N_lon', nc) ;Define x-dimension +;yid = NCDF_DIMDEF(id, 'N_lat', nr) ;Define y-dimension +;NCDF_ATTPUT,id, 'CellSize_arcmin' , 3,/global +;NCDF_ATTPUT,id, 'CreatedBy', 'Sarith Mahanama GSFC/NASA',/global +;NCDF_ATTPUT,id, 'Contact', 'Anyone from GMAO Land Group',/global +;str_date=systime() +;NCDF_ATTPUT,id, 'Date', str_date,/global +;vid = NCDF_VARDEF(id, 'lat', yid, /DOUBLE) ;Define latitude variable +;vid = NCDF_VARDEF(id, 'lon', xid, /DOUBLE) ;Define longitude variable +;vid = NCDF_VARDEF(id, 'LAI', [xid, yid], /SHORT) +;NCDF_ATTPUT, id, vid, 'LongName','Leaf Area Index 8-Day 0.05-degrees GEO Grid climatology' +;NCDF_ATTPUT, id, vid, 'units', 'm^2/m^2' +;NCDF_ATTPUT, id, vid, 'scale_factor',0.01 +;NCDF_ATTPUT, id, vid, 'valid_range','0 1000' +;NCDF_ATTPUT, id, vid, '_FillValue', 2550 +; +;NCDF_CONTROL, id, /ENDEF +; +;dxy = 360.d/7200.d +; +;x = indgen (nc)*dxy -180. + dxy/2.d +;y = indgen (nr)*dxy -90. + dxy/2.d +; +;NCDF_VARPUT, id,'lat', y +;NCDF_VARPUT, id,'lon', x +;for j =0, nr -1 do begin +;NCDF_VARPUT, id, 'LAI',offset=[0,nr-1 -j],count=[nc,1] , nint(indata [*,j]) +;endfor +;NCDF_CLOSE, id +; +;end ; ------------------------------------------------------------------- pro irrig_method, ncat, tile_id diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_README.csh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/create_README.csh similarity index 99% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_README.csh rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/create_README.csh index dda2457bb..168faaf4e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_README.csh +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/create_README.csh @@ -1492,8 +1492,8 @@ cat << _EOF1_ > clsm/README2 7.2 Data files 7.2.1 Pafafstetter catchment connectivity, channel information - file name : /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ - SRTM-TopoData/Pfafcatch-routing.dat + file path : /discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ [NCCS/Discover] + file name : land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat read ([UNIT],*) NPfafs do n = 1, ${NPfafs} read ([UNIT],'(i8,i15,4(1x,f9.4),1x,e10.3,4(1x,e9.3),I8,6(1x,f9.4))') & @@ -1543,7 +1543,9 @@ cat << _EOF2_ > clsm/README3 8.1 Data generation and processing chain A GIS shape file of global administrative areas map was obtained from (https://gadm.org) - It was rasterized to 30-arcsec and created the data/CATCH/GADM_Country_and_USStates_codes_1km.nc4 file. + It was rasterized to 30-arcsec and stored as + file path : /discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ [NCCS/Discover] + file name : land/misc/country_codes/v1/GADM_Country_and_USStates_codes_1km.nc4 8.2 Data files 8.2.1 Country Code, US State Code, Country Name, State Name diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/findloc.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/findloc.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/findloc.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/findloc.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs similarity index 93% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs index 8d6d0b50f..6a582db3b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs @@ -302,15 +302,15 @@ if ($isEASE > 0) then else echo "Options for ocean horizontal resolution:" echo " " - echo " ${C2}O1 -- Low-Resolution Reynolds 1 deg${CR} (Lon/Lat Data-Ocean: 360x180 )" - echo " ${C2}O2 -- Med-Resolution Reynolds 1/4 deg${CR} (Lon/Lat Data-Ocean: 1440x720 )" - echo " ${C2}O3 -- High-Resolution OSTIA 1/8 deg${CR} (Lon/Lat Data-Ocean: 2880x1440)" - echo " ${C2}T2 -- Med-Resolution Tripolar 1 deg${CR} (MOM-Tripolar-Ocean: 360x200 )" - echo " ${C2}T3 -- High-Resolution Tripolar 1/2 deg${CR} (MOM-Tripolar-Ocean: 720x410 )" - echo " ${C2}T4 -- High-Resolution Tripolar 1/4 deg${CR} (MOM-Tripolar-Ocean: 1440x1080)" - echo " ${C2}T1MOM6 -- Low-Resolution Tripolar 5 deg${CR} (MOM6-Tripolar-Ocean: 72x36 )" -# echo " ${C2}T2MOM6 -- Med-Resolution Tripolar 1 deg${CR} (MOM6-Tripolar-Ocean: 360x210 )" - echo " ${C2}T4MOM6 -- High-Resolution Tripolar 1/4 deg${CR} (MOM6-Tripolar-Ocean: 1440x1080)" + echo " ${C2}O1 -- Reynolds ${CR} (Lon/Lat Data-Ocean: 360x180 )" + echo " ${C2}O2 -- Reynolds ${CR} (Lon/Lat Data-Ocean: 1440x720 )" + echo " ${C2}O3 -- OSTIA ${CR} (Lon/Lat Data-Ocean: 2880x1440)" + echo " ${C2}T2 -- Tripolar ${CR} (MOM5-Tripolar-Ocean: 360x200 )" + echo " ${C2}T3 -- Tripolar ${CR} (MOM5-Tripolar-Ocean: 720x410 )" + echo " ${C2}T4 -- Tripolar ${CR} (MOM5-Tripolar-Ocean: 1440x1080)" + echo " ${C2}T1MOM6 -- Tripolar ${CR} (MOM6-Tripolar-Ocean: 72x36 )" + echo " ${C2}T3MOM6 -- Tripolar ${CR} (MOM6-Tripolar-Ocean: 580x458 )" + echo " ${C2}T4MOM6 -- Tripolar ${CR} (MOM6-Tripolar-Ocean: 1440x1080)" echo " ${C2}CS -- Cubed-Sphere Ocean ${CR} (Cubed-Sphere Data-Ocean )" echo " " @@ -336,7 +336,7 @@ ORSLV: $orslv != 'T3' & \ $orslv != 'T4' & \ $orslv != 'T1MOM6' & \ - $orslv != 'T2MOM6' & \ + $orslv != 'T3MOM6' & \ $orslv != 'T4MOM6' & \ $orslv != 'CS') then echo " ${C1} Invalid choice. Note that entries are case-sensitive. Try again:${CR}" @@ -420,22 +420,21 @@ foreach orslv ($orslvs) set HOSTNAME = `hostname | rev | cut -c3- | rev` if ( $HOSTNAME == discover ) then - set input_dir = /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ + setenv MAKE_BCS_INPUT_DIR /discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ else - set input_dir = /nobackup/gmao_SIteam/ModelData/l_data/LandBCs_files_for_mkCatchParam/V001/ + setenv MAKE_BCS_INPUT_DIR /nobackup/gmao_SIteam/ModelData/make_bcs_inputs/ endif - if ( $orslv == O1 | $orslv == T2 | $orslv == T3 | $orslv == T4 | \ - $orslv == T1MOM6 | $orslv == T2MOM6 | $orslv == T4MOM6 ) then + $orslv == T1MOM6 | $orslv == T3MOM6 | $orslv == T4MOM6 ) then # Great-Lakes & Caspian-Sea treated as Model LAKE tiles, Surface Temperatures will be Model Derived # ------------------------------------------------------------------------------------------------- if ( $lbcsv == F25 | $lbcsv == GM4 | $lbcsv == ICA ) then - set GLOBAL_CATCH_DATA = ${input_dir}/global.cat_id.catch.DL + set GLOBAL_CATCH_DATA = ${MAKE_BCS_INPUT_DIR}/shared/mask/global.cat_id.catch.DL else - set GLOBAL_CATCH_DATA = ${input_dir}/GEOS5_10arcsec_mask_freshwater-lakes.nc + set GLOBAL_CATCH_DATA = ${MAKE_BCS_INPUT_DIR}/shared/mask/GEOS5_10arcsec_mask_freshwater-lakes.nc endif @@ -445,9 +444,9 @@ else if ( $orslv == O2 | $orslv == O3 | $orslv == CS ) then # -------------------------------------------------------------------------------------------------------------- if ( $lbcsv == F25 | $lbcsv == GM4 | $lbcsv == ICA ) then - set GLOBAL_CATCH_DATA = ${input_dir}/global.cat_id.catch.GreatLakesCaspian_Updated.DL + set GLOBAL_CATCH_DATA = ${MAKE_BCS_INPUT_DIR}/shared/mask/global.cat_id.catch.GreatLakesCaspian_Updated.DL else - set GLOBAL_CATCH_DATA = ${input_dir}/GEOS5_10arcsec_mask.nc + set GLOBAL_CATCH_DATA = ${MAKE_BCS_INPUT_DIR}/shared/mask/GEOS5_10arcsec_mask.nc endif else @@ -458,7 +457,7 @@ else endif if($HRCODE == M01 | $HRCODE == M03 | $HRCODE == M09 | $HRCODE == M25 | $HRCODE == M36) then - set GLOBAL_CATCH_DATA = ${input_dir}/GEOS5_10arcsec_mask.nc + set GLOBAL_CATCH_DATA = ${MAKE_BCS_INPUT_DIR}/shared/mask/GEOS5_10arcsec_mask.nc endif set MASKFILE = `echo ${GLOBAL_CATCH_DATA} | rev | cut -d / -f1 | rev ` @@ -490,28 +489,28 @@ if( $orslv == O3 ) then @ jmo = 1440 # Lat/Lon Data-Ocean (OSTIA 1/8-deg) endif if( $orslv == T2 ) then - @ imo = 360 # MOM Tripolar-Ocean - @ jmo = 200 # MOM Tripolar-Ocean + @ imo = 360 # MOM5 Tripolar-Ocean + @ jmo = 200 # MOM5 Tripolar-Ocean endif if( $orslv == T3 ) then - @ imo = 720 # MOM Tripolar-Ocean - @ jmo = 410 # MOM Tripolar-Ocean + @ imo = 720 # MOM5 Tripolar-Ocean + @ jmo = 410 # MOM5 Tripolar-Ocean endif if( $orslv == T4 ) then - @ imo = 1440 # MOM Tripolar-Ocean - @ jmo = 1080 # MOM Tripolar-Ocean + @ imo = 1440 # MOM5 Tripolar-Ocean + @ jmo = 1080 # MOM5 Tripolar-Ocean endif if( $orslv == T1MOM6 ) then - @ imo = 72 # MOM6 Tripolar-Ocean - @ jmo = 36 # MOM6 Tripolar-Ocean + @ imo = 72 # MOM6 Tripolar-Ocean + @ jmo = 36 # MOM6 Tripolar-Ocean endif -if( $orslv == T2MOM6 ) then - @ imo = 360 # MOM6 Tripolar-Ocean - @ jmo = 210 # MOM6 Tripolar-Ocean +if( $orslv == T3MOM6 ) then + @ imo = 540 # MOM6 Tripolar-Ocean + @ jmo = 458 # MOM6 Tripolar-Ocean endif if( $orslv == T4MOM6 ) then - @ imo = 1440 # MOM6 Tripolar-Ocean - @ jmo = 1080 # MOM6 Tripolar-Ocean + @ imo = 1440 # MOM6 Tripolar-Ocean + @ jmo = 1080 # MOM6 Tripolar-Ocean endif if( $orslv == O1 | $orslv == O2| $orslv == O3 ) then @@ -519,13 +518,13 @@ if( $orslv == O1 | $orslv == O2| $orslv == O3 ) then set DATENAME = DE set POLENAME = PE endif -set MOM_VERSION = MOM5 +set MOM_VERSION = UNDEF if( $orslv == T2 | $orslv == T3 | $orslv == T4 ) then set TRIPOL_OCEAN = TRUE set MOM_VERSION = MOM5 set DATENAME = TM set POLENAME = TM -else if ( $orslv == T1MOM6 | $orslv == T2MOM6 | $orslv == T4MOM6 ) then +else if ( $orslv == T1MOM6 | $orslv == T3MOM6 | $orslv == T4MOM6 ) then set TRIPOL_OCEAN = TRUE set MOM_VERSION = MOM6 set DATENAME = TM @@ -757,7 +756,6 @@ while ("$group" == "") end - ####################################################################### # LatLon Case ####################################################################### @@ -813,14 +811,15 @@ cd $BCDIR /bin/ln -s $bin_dir source bin/g5_modules mkdir -p til rst data/MOM5 data/MOM6 clsm/plots -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/360x200 data/MOM5/360x200 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/720x410 data/MOM5/720x410 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/1440x1080 data/MOM5/1440x1080 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/72x36 data/MOM6/72x36 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/1440x1080 data/MOM6/1440x1080 + +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/360x200 data/MOM5/360x200 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/720x410 data/MOM5/720x410 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/1440x1080 data/MOM5/1440x1080 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/72x36 data/MOM6/72x36 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/540x458 data/MOM6/540x458 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/1440x1080 data/MOM6/1440x1080 cd data -ln -s $input_dir CATCH cd ../ @@ -991,14 +990,16 @@ cd $BCDIR /bin/ln -s $bin_dir source bin/g5_modules mkdir -p til rst data/MOM5 data/MOM6 clsm/plots -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/360x200 data/MOM5/360x200 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/720x410 data/MOM5/720x410 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/1440x1080 data/MOM5/1440x1080 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/72x36 data/MOM6/72x36 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/1440x1080 data/MOM6/1440x1080 + +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/360x200 data/MOM5/360x200 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/720x410 data/MOM5/720x410 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/1440x1080 data/MOM5/1440x1080 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/72x36 data/MOM6/72x36 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/540x458 data/MOM6/540x458 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/1440x1080 data/MOM6/1440x1080 + cd data -ln -s $input_dir CATCH cd ../ if( -e CF${NC}x6C_${DATENAME}${IMO}x${POLENAME}${JMO}.stdout ) /bin/rm -f CF${NC}x6C_${DATENAME}${IMO}x${POLENAME}${JMO}.stdout @@ -1177,14 +1178,15 @@ cd $BCDIR /bin/ln -s $bin_dir source bin/g5_modules mkdir -p til rst data/MOM5 data/MOM6 clsm/plots -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/360x200 data/MOM5/360x200 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/720x410 data/MOM5/720x410 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM5/1440x1080 data/MOM5/1440x1080 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/72x36 data/MOM6/72x36 -ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/1440x1080 data/MOM6/1440x1080 + +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/360x200 data/MOM5/360x200 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/720x410 data/MOM5/720x410 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM5/1440x1080 data/MOM5/1440x1080 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/72x36 data/MOM6/72x36 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/540x458 data/MOM6/540x458 +ln -s $MAKE_BCS_INPUT_DIR/ocean/MOM6/1440x1080 data/MOM6/1440x1080 cd data -ln -s $input_dir CATCH cd ../ @@ -1307,11 +1309,13 @@ cd ../../ /bin/mv $BCJOB $BCNAME /bin/mv $EXPDIR/$OUTDIR/logs $BCNAME/. /bin/mv $BCNAME/clsm/mkCatchParam.log $BCNAME/logs/mkCatchParam.log -/bin/rm -r $OUTDIR +#/bin/rm -r $OUTDIR #mkdir -p IRRIG/$BCNAME/clsm #bin/mkIrrigTiles.x -b $BCNAME -t CF${NC}x6C_${DATENAME}${IMO}x${POLENAME}${JMO}-Pfafstetter.til -r _${RC} -p $IRRIGTHRES +/bin/rm -r $OUTDIR + _EOF_ chmod 755 $BCJOB set make_bcs_jobs = `echo $make_bcs_jobs $BCJOB` @@ -1371,7 +1375,6 @@ cd $BCDIR source bin/g5_modules mkdir -p til rst data/MOM5 data/MOM6 clsm/plots cd data -ln -s $input_dir CATCH cd ../ limit stacksize unlimited diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs.py similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs.py rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs.py diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_cube_bcs.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_cube_bcs.py similarity index 99% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_cube_bcs.py rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_cube_bcs.py index 52cf736d5..80709d048 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_cube_bcs.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_cube_bcs.py @@ -28,7 +28,6 @@ ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/1440x1080 data/MOM6/1440x1080 cd data -ln -s {input_dir} CATCH cd ../ if( -e CF{NC}x6C_{DATENAME}{IMO}x{POLENAME}{JMO}.stdout ) /bin/rm -f CF{NC}x6C_{DATENAME}{IMO}x{POLENAME}{JMO}.stdout @@ -175,11 +174,11 @@ ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/1440x1080 data/MOM6/1440x1080 cd data -ln -s {input_dir} CATCH cd ../ if( -e CF{NC}x6C_{DATENAME}{IMO}x{POLENAME}{JMO}.stdout ) /bin/rm -f CF{NC}x6C_{DATENAME}{IMO}x{POLENAME}{JMO}.stdout setenv MASKFILE {MASKFILE} +setenv MAKE_BCS_INPUT_DIR {MAKE_BCS_INPUT_DIR} limit stacksize unlimited bin/mkCubeFVRaster.x -x {NX} -y {NY} {NC} >/dev/null bin/mkLandRaster.x -x {NX} -y {NY} -v -t {NT} @@ -229,6 +228,7 @@ source bin/g5_modules setenv MASKFILE {MASKFILE} +setenv MAKE_BCS_INPUT_DIR $input_dir limit stacksize unlimited if( {LATLON_OCEAN} == TRUE ) then @@ -375,7 +375,7 @@ def make_cube_bcs(config): OUTDIR = tmp_dir, \ BCNAME = bcname, \ bin_dir = bin_dir, \ - input_dir = config['inputdir'], \ + MAKE_BCS_INPUT_DIR = config['inputdir'], \ BCJOB = bcjob, \ EASEVERSION = grid_type, \ HRCODE = resolution, \ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_ease_bcs.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_ease_bcs.py similarity index 98% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_ease_bcs.py rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_ease_bcs.py index 524bfe7b6..257997090 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_ease_bcs.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_ease_bcs.py @@ -22,11 +22,11 @@ source bin/g5_modules mkdir -p til rst data/MOM5 data/MOM6 clsm/plots cd data -ln -s {input_dir} CATCH cd ../ limit stacksize unlimited setenv MASKFILE {MASKFILE} +setenv MAKE_BCS_INPUT_DIR {MAKE_BCS_INPUT_DIR} setenv OMP_NUM_THREADS 1 bin/mkEASETilesParam.x -ease_label {BCNAME} setenv OMP_NUM_THREADS 1 @@ -131,7 +131,7 @@ def make_ease_bcs(config): OUTDIR = tmp_dir, \ BCNAME = EASElabel, \ bin_dir = bin_dir, \ - input_dir = config['inputdir'], \ + MAKE_BCS_INPUT_DIR = config['inputdir'], \ BCJOB = bcjob, \ EASEVERSION = grid_type, \ HRCODE = resolution, \ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_latlon_bcs.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_latlon_bcs.py similarity index 98% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_latlon_bcs.py rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_latlon_bcs.py index 0591c1074..0f120958f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_latlon_bcs.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_latlon_bcs.py @@ -28,11 +28,11 @@ ln -s /discover/nobackup/projects/gmao/ssd/aogcm/ocean_bcs/MOM6/1440x1080 data/MOM6/1440x1080 cd data -ln -s {input_dir} CATCH cd ../ if( -e DC{IM}xPC{JM}_{DATENAME}{IMO}x{POLENAME}{JMO}.stdout ) /bin/rm -f DC{IM}xPC{JM}_{DATENAME}{IMO}{POLENAME}{JMO}.stdout setenv MASKFILE {MASKFILE} +setenv MAKE_BCS_INPUT_DIR {MAKE_BCS_INPUT_DIR} limit stacksize unlimited bin/mkLatLonRaster.x -x {NX} -y {NY} -t -1 {IM} {JM} >/dev/null bin/mkLandRaster.x -x {NX} -y {NY} -v -t {NT} @@ -179,7 +179,7 @@ def make_cube_bcs(config): OUTDIR = tmp_dir, \ BCNAME = bcname, \ bin_dir = bin_dir, \ - input_dir = config['inputdir'], \ + MAKE_BCS_INPUT_DIR = config['inputdir'], \ BCJOB = bcjob, \ EASEVERSION = grid_type, \ HRCODE = resolution, \ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 similarity index 99% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 index db921e3e1..97c1e6850 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90 @@ -99,8 +99,6 @@ PROGRAM mkCatchParam ! !$OMP ENDPARALLEL -! call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') -! call execute_command_line('cd ..') USAGE(1) ="Usage: mkCatchParam -x nx -y ny -g Gridname -b DL -v LBCSV " USAGE(2) =" -x: Size of longitude dimension of input raster. DEFAULT: 8640 " diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCubeFVRaster.F90 similarity index 96% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCubeFVRaster.F90 index 02c7c3c90..43b9646c7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCubeFVRaster.F90 @@ -1,6 +1,5 @@ -! $Id: - -#include "Raster.h" +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program mkCubeFVRaster @@ -18,7 +17,7 @@ program mkCubeFVRaster ! use CubedSphere_GridMod use LogRectRasterizeMod - + use MAPL_ExceptionHandling !EOP implicit none @@ -36,6 +35,7 @@ program mkCubeFVRaster logical :: Here=.false. logical :: Verb=.false. character*128 :: Usage="mkCubeFVraster -x RX -y RY -z -h -v -g GN ncells" + character*128 :: Iam ="mkCubeFVraster" ! Process Arguments !------------------ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkEASETilesParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkEASETilesParam.F90 similarity index 95% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkEASETilesParam.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkEASETilesParam.F90 index db0ae03db..6f6f4efa6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkEASETilesParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkEASETilesParam.F90 @@ -1,4 +1,5 @@ -#include "Raster.h" +#define I_AM_MAIN +#include "MAPL_ErrLog.h" PROGRAM mkEASETilesParam @@ -9,7 +10,7 @@ PROGRAM mkEASETilesParam ! and mkSMAPTilesPara_v2.F90 in September 2022. ! Before the merger and cleanup, the EASE grid parameters were hard-coded here. ! For EASEv2 M25, the outdated scale value was used here. - ! This is program is renamed to mkEASETileParam from mkSMAPTilesPara_v2 + ! The program was renamed to mkEASETileParam from mkSMAPTilesPara_v2 ! ! - wjiang + reichle, 21 Sep 2022 @@ -17,9 +18,11 @@ PROGRAM mkEASETilesParam use EASE_conv use rmTinyCatchParaMod, only : i_raster, j_raster, SRTM_maxcat use rmTinyCatchParaMod, only : RegridRaster, RegridRaster1, RegridRasterReal + use rmTinyCatchParaMod, only : MAKE_BCS_INPUT_DIR use process_hres_data use MAPL_SortMod use MAPL_ConstantsMod + use MAPL_ExceptionHandling use LogRectRasterizeMod use netcdf @@ -60,9 +63,9 @@ PROGRAM mkEASETilesParam real :: clat, clon, r_ease, s_ease, da real :: fr_gcm integer :: ind_col, ind_row, status, ncid, varid, nciv,nland_cells, DOM_INDX - REAL (kind=8), PARAMETER :: RADIUS=6378137.0,pi=3.14159265358979323846 + !REAL (kind=8), PARAMETER :: RADIUS=6378137.0,pi=3.14159265358979323846 character*100 :: veg_class (12) - character*100 :: gfile,gtopo30 + character*200 :: gfile,gtopo30 integer :: nc_ease,nr_ease, N_args, command_argument_count REAL :: dx,dy,d2r,lats,mnx,mxx,mny,mxy,sum1,sum2,jgv, VDUM,pix_area character(40) :: arg, EASElabel_ @@ -74,7 +77,10 @@ PROGRAM mkEASETilesParam character*1 :: PF character(len=6) :: EASE_Version character(len=10) :: nc_string, nr_string - character(128) :: usage1, usage2 + character(len=128) :: usage1, usage2 + character(len=128) :: Iam = "mkEASETilesParam" + + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) ! -------------------------------------------------------------------------------------- @@ -119,10 +125,6 @@ PROGRAM mkEASETilesParam ! stop ("EASEv1 only supports M25") ! endif - ! WY noted: should do it in the script that calls this program - !call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') - !call execute_command_line('cd ..') - ! Setting EASE Grid specifications ! -------------------------------- @@ -197,7 +199,7 @@ PROGRAM mkEASETilesParam allocate(geos_msk (1:nc_esa,1:dy_esa)) allocate(SRTM_CatchArea (1:SRTM_maxcat)) - OPEN (10, FILE = 'data/CATCH/SRTM-TopoData/Pfafcatch-routing.dat', & + OPEN (10, FILE = trim(MAKE_BCS_INPUT_DIR)//'/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat', & FORM = 'FORMATTED',STATUS='OLD',ACTION='READ') READ (10,*) I @@ -210,14 +212,14 @@ PROGRAM mkEASETilesParam dx = 360._8/nc dy = 180._8/nr - d2r = PI/180._8 - da = MAPL_radius*MAPL_radius*pi*pi*dx*dy/180./180./1000000. + d2r = MAPL_PI_R8/180._8 + !da = MAPL_radius*MAPL_radius*pi*pi*dx*dy/180./180./1000000. tileid_index = 0 catid_index = 0 veg = 0 - status = NF90_OPEN ('data/CATCH/GEOS5_10arcsec_mask.nc', NF90_NOWRITE, ncid) + status = NF90_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/GEOS5_10arcsec_mask.nc', NF90_NOWRITE, ncid) status = nf90_inq_varid(ncid, name='PfafID', varid=varid) status = nf90_get_var(ncid, varid, SRTM_catid_r8, (/1/),(/SRTM_maxcat/)) if(status /=0) then @@ -327,8 +329,8 @@ PROGRAM mkEASETilesParam dx = 360._8/nc dy = 180._8/nr - d2r = PI/180._8 - da = MAPL_radius*MAPL_radius*pi*pi*dx*dy/180./180./1000000. + d2r = MAPL_PI_R8/180._8 + !da = MAPL_radius*MAPL_radius*pi*pi*dx*dy/180./180./1000000. tileid_index = 0 @@ -354,7 +356,7 @@ PROGRAM mkEASETilesParam ! 2.5'x2.5' vegetation raster file is global 1min IGBP data ! (ftp://edcftp.cr.usgs.gov/pub/data/glcc/globe/latlon/sib22_0.leg) - open (10,file='data/CATCH/sib22.5_v2.0.dat', & + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/veg/pft/v1/sib22.5_v2.0.dat', & form='unformatted', & action='read', convert='big_endian',status='old') @@ -378,7 +380,7 @@ PROGRAM mkEASETilesParam ! 1 global inland water (lakes) catchment : Pfafstetter ID 6190000 ! 1 global ice catchment : Pfafstetter ID 6200000 - open (10,file='data/CATCH/global.cat_id.catch.DL', form='formatted', & + open (10,file= trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/global.cat_id.catch.DL', form='formatted', & action='read', status='old')! do j=1,j_raster @@ -404,7 +406,7 @@ PROGRAM mkEASETilesParam ! 1 global ice catchment : tile_index 36718 ! ------------------------------------------------------------ - open (10,file='data/CATCH/' & + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/topo/' & //'PfafstatterDL.rst', form='unformatted', & action='read',convert='little_endian', status='old') @@ -469,7 +471,7 @@ PROGRAM mkEASETilesParam allocate(raster (i_raster,j_raster)) allocate(q0(nc,nr)) - gtopo30 = 'data/CATCH/srtm30_withKMS_2.5x2.5min.data' + gtopo30 = trim(MAKE_BCS_INPUT_DIR)//'/land/topo/v1/srtm30_withKMS_2.5x2.5min.data' open (10,file=trim(gtopo30),form='unformatted',status='old',convert='little_endian') read (10) raster diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkLandRaster.F90 similarity index 94% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkLandRaster.F90 index f42a5adc0..5c2494f28 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkLandRaster.F90 @@ -1,14 +1,14 @@ - -#include "Raster.h" +#define I_AM_MAIN +#include "MAPL_ErrLog.h" Program MakeLandRaster - + use MAPL_ExceptionHandling use LogRectRasterizeMod use MAPL_HashMod use process_hres_data use MAPL_SortMod - use rmTinyCatchParaMod, ONLY: SRTM_maxcat - + use rmTinyCatchParaMod, ONLY: SRTM_maxcat, MAKE_BCS_INPUT_DIR + use MAPL_Constants, only: PI=>MAPL_PI_R8 ! Program to create a surface raster file at 2.5' that has ! the ocean divided with a regular lat-lon DE grid. Its inputs ! are Sarith's formatted 2.5' raster of the Pfafstetter catchments with @@ -28,11 +28,11 @@ Program MakeLandRaster integer :: type, maxtiles, nx, ny integer :: count0,count1,count_rate - REAL_ :: dx, dy, d2r ! Grid spacing of raster grid - REAL_ :: xmin, ymin, xmax, ymax, xs, ys, da + real(kind=8) :: dx, dy, d2r ! Grid spacing of raster grid + real(kind=8) :: xmin, ymin, xmax, ymax, xs, ys, da - REAL_, allocatable :: cc(:), ss(:) - REAL_ , allocatable :: rTable(:,:) + real(kind=8), allocatable :: cc(:), ss(:) + real(kind=8) , allocatable :: rTable(:,:) integer, pointer :: Raster(:,:) integer, allocatable, target :: Raster0(:,:) @@ -45,8 +45,7 @@ Program MakeLandRaster logical :: Verb logical :: regrid, reynolds_sst = .false. - REAL_ :: VV(4) - REAL_ :: PI=RASTER_PI + real(kind=8) :: VV(4) ! ESA/SRTM ocean/land/ice/lake mask parameters ! -------------------------------------------- @@ -72,9 +71,9 @@ Program MakeLandRaster character*128 :: MaskFile character*128 :: & Usage = "mkLandRaster -x nx -y ny -v -h -z -t maxtiles -l LandFile -g GridName" + character*128 :: Iam = "MakeLandRaster" include 'netcdf.inc' - call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') - call execute_command_line('cd ..') + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) ! Process Arguments !------------------ @@ -87,8 +86,7 @@ Program MakeLandRaster tildir = 'til/' ! Write in current dir rstdir = 'rst/' ! Write in current dir maxtiles = 50000 - InputFile = & - "data/CATCH/global.cat_id.catch.DL" + InputFile = trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/global.cat_id.catch.DL' I = command_argument_count() @@ -182,7 +180,7 @@ Program MakeLandRaster ss(i) = sin(xs) enddo - InputFile = 'data/CATCH/'//trim(MaskFile) + InputFile = trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/'//trim(MaskFile) if (index(trim(MaskFile),'GEOS5_10arcsec_mask')/=0) then ! 10 arcsec new mask @@ -196,7 +194,7 @@ Program MakeLandRaster allocate(geos_msk (1:nc_esa,1:dy_esa)) allocate (raster (1:nx, 1:ny)) - InputFile = 'data/CATCH/'//trim(MaskFile) + InputFile = trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/'//trim(MaskFile) status = NF_OPEN (InputFile, NF_NOWRITE, ncid) @@ -217,7 +215,7 @@ Program MakeLandRaster print *, 'Using Reynolds SSTs MASKFILE',trim(MaskFile) reynolds_sst = .true. - InputFile = 'data/CATCH/GEOS5_10arcsec_mask.nc' + InputFile = trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/GEOS5_10arcsec_mask.nc' status = NF_OPEN (InputFile, NF_NOWRITE, ncid2) allocate(geos_msk2 (1:nc_esa,1:dy_esa)) endif @@ -500,7 +498,7 @@ subroutine RegridRaster(Rin,Rout) integer, intent(IN) :: Rin(:,:) integer, intent(OUT) :: Rout(:,:) - REAL_ :: xx, yy + real(kind=8) :: xx, yy integer :: i,j,ii,jj xx = size(Rin ,1)/float(size(Rout,1)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkLatLonRaster.F90 similarity index 97% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkLatLonRaster.F90 index 6812a6bfe..05c220ebd 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkLatLonRaster.F90 @@ -1,6 +1,5 @@ -! $Id: - -#include "Raster.h" +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program mkLatLonRaster @@ -46,6 +45,7 @@ program mkLatLonRaster ! in each box. use LogRectRasterizeMod + use MAPL_ExceptionHandling implicit none @@ -64,6 +64,7 @@ program mkLatLonRaster real*8, allocatable :: xs(:), ys(:), xv(:,:,:), yv(:,:,:) character*128 :: & Usage = "mkLatLonRaster -x nx -y ny -v -h -z -g Gridname -b lon0 -p pos -t type im jm" + character*128 :: Iam = "mkLatLonRaster" ! Process Arguments !------------------ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkMITAquaRaster.F90 similarity index 98% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkMITAquaRaster.F90 index e2a64a68c..efeb89d49 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkMITAquaRaster.F90 @@ -1,10 +1,10 @@ - -#include "Raster.h" -!#define VERIFY_(A) if (A/=0) stop 'verify error' +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program MAIN use LogRectRasterizeMod + use MAPL_ExceptionHandling implicit none @@ -101,6 +101,7 @@ program MAIN integer, dimension(MAXBLNKSZ) :: blankList real(kind=RKIND) :: areamin, xc, yc + character(len=128) :: Iam = "mkMITAquaRaster" NAMELIST /W2_EXCH2_PARM01/ sNx, SNy, blankList diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkMOMAquaRaster.F90 similarity index 91% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkMOMAquaRaster.F90 index 4f7dff4a1..6532c91d3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkMOMAquaRaster.F90 @@ -1,11 +1,9 @@ -! $Id: - -#include "Raster.h" - +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program MOMraster use LogRectRasterizeMod - + use MAPL_ExceptionHandling implicit none ! this program builds a rasterized grid whose cells are 2.5 by 2.5 minutes @@ -15,9 +13,9 @@ program MOMraster ! via namelist hence can be changed at runtime integer :: im, jm ! dimensions of MOM grid - REAL_, pointer :: xvert(:,:,:) ! Lons of MOM's vertices - REAL_, pointer :: yvert(:,:,:) ! Lats of MOM's vertices - REAL_ :: xmin, xmax + real(kind=8), pointer :: xvert(:,:,:) ! Lons of MOM's vertices + real(kind=8), pointer :: yvert(:,:,:) ! Lats of MOM's vertices + real(kind=8) :: xmin, xmax integer :: i, j, nxt,k integer :: status, command_argument_count character*(128) :: GridFile @@ -26,6 +24,7 @@ program MOMraster character*(2) :: opt character*(128) :: & Usage = "mkMOMAquaRaster -x rx -y ry -z -v -g GridName -h GridSpecFile" + character*(128) :: Iam = "mkMOMAquaRaster" ! argument defaults @@ -35,7 +34,7 @@ program MOMraster integer :: Nc = 8640 integer :: NR = 4320 - REAL_ :: tol + real(kind=8) :: tol INCLUDE "netcdf.inc" ! Process Arguments @@ -145,13 +144,13 @@ end subroutine FieldSize subroutine ReadGridFile(FILE,XVERT,YVERT) character*(*), intent(IN ) :: FILE - REAL_, pointer :: XVERT(:,:,:) - REAL_, pointer :: YVERT(:,:,:) + real(kind=8), pointer :: XVERT(:,:,:) + real(kind=8), pointer :: YVERT(:,:,:) integer :: STATUS, NCID, VARID integer :: SIZ_XVERT_X, SIZ_XVERT_Y integer :: SIZ_YVERT_X, SIZ_YVERT_Y - REAL_, pointer :: VERTX(:,:),VERTY(:,:) + real(kind=8), pointer :: VERTX(:,:),VERTY(:,:) Status=NF_OPEN(FILE,NF_NOWRITE,NCID) _ASSERT(STATUS==NF_NOERR,'needs informative message') diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 similarity index 97% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 19b9c861e..298895f5c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -16,7 +16,11 @@ program Runoff integer :: numtrans, numclosed integer :: status character*100 :: file, fileT, fileR, fileO, fileB, fileBB - character*100 :: fileLL="data/CATCH/Outlet_latlon." + + character*400 :: fileLL + character*400 :: MAKE_BCS_INPUT_DIR + + character*5 :: C_NX, C_NY logical :: adjust_oceanLandSea_mask = .false. ! default is .false. @@ -25,6 +29,11 @@ program Runoff Usage = "mk_runofftbl.x CF0012x6C_TM0072xTM0036-Pfafstetter", & mapl_tp_file + + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/Outlet_latlon.' + + ! Read inputs ----------------------------------------------------- I = command_argument_count() if (I < 1 .or. I > 3) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mod_process_hres_data.F90 similarity index 97% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mod_process_hres_data.F90 index 4909efa06..8efc7f826 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mod_process_hres_data.F90 @@ -22,8 +22,7 @@ MODULE process_hres_data use rmTinyCatchParaMod use MAPL_SortMod -use date_time_util -use leap_year +use LDAS_DateTimeMod use MAPL_ConstantsMod use lsm_routines, ONLY: sibalb use MAPL_Base, ONLY: MAPL_UNDEF @@ -103,10 +102,11 @@ SUBROUTINE ESA2CLM (nc, nr, gfile) ! Reading CLM pft data file !-------------------------- + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) ALLOCATE (PCTPFT (1:N_lon_clm, 1:N_lat_clm, 1:lsmpft)) ALLOCATE (PCT_PFT_DBL (1:N_lon_clm, 1:N_lat_clm, 1:lsmpft)) - status = NF_OPEN ('data/CATCH/surfdata_0.23x0.31_simyr2000_c100406.nc', NF_NOWRITE, ncid) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/pft/v2/surfdata_0.23x0.31_simyr2000_c100406.nc', NF_NOWRITE, ncid) status = NF_GET_VARA_DOUBLE (ncid,1,(/1/),(/1/),EDGEN) ; VERIFY_(STATUS) status = NF_GET_VARA_DOUBLE (ncid,2,(/1/),(/1/),EDGEE) ; VERIFY_(STATUS) status = NF_GET_VARA_DOUBLE (ncid,3,(/1/),(/1/),EDGES) ; VERIFY_(STATUS) @@ -195,7 +195,7 @@ SUBROUTINE ESA2CLM (nc, nr, gfile) allocate (lon_esa (1:nc_esa)) allocate (lat_esa (1:nr_esa)) - status = NF_OPEN ('data/CATCH/ESA_GlobalCover.nc', NF_NOWRITE, ncid) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/pft/v2/ESA_GlobalCover.nc', NF_NOWRITE, ncid) if(status /=0) then PRINT *, NF_STRERROR(STATUS) @@ -824,7 +824,8 @@ SUBROUTINE ESA2MOSAIC (nc, nr, gfile) allocate (esa_veg (1:nc_esa, 1: nr_esa)) - status = NF_OPEN ('data/CATCH/ESA_GlobalCover.nc', NF_NOWRITE, ncid) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/pft/v2/ESA_GlobalCover.nc', NF_NOWRITE, ncid) if(status /=0) then PRINT *, NF_STRERROR(STATUS) @@ -1760,7 +1761,7 @@ SUBROUTINE modis_alb_on_tiles_high (nc_data,nr_data,rmap,MA,gfiler) integer :: n,maxcat,i,j,k,ncid,i_highd,j_highd,nx_adj,ny_adj, pix_count integer :: status,iLL,jLL,ix,jx,vid,nc_10,nr_10,n_tslices,d_undef,t, & time_slice,time_slice_next,yr,mn,dd,yr1,mn1,dd1,i1,i2 - character*100 :: fname,fout + character*200 :: fname,fout character*10 :: string character*2 :: VV,HH integer, allocatable, dimension (:,:) :: & @@ -1779,8 +1780,9 @@ SUBROUTINE modis_alb_on_tiles_high (nc_data,nr_data,rmap,MA,gfiler) read(10,*) maxcat close (10,status='keep') - if(MA=='MODIS1') fname =trim(c_data)//'MODIS-Albedo/MODISalb.c004.v2.WS_H11V13.nc' - if(MA=='MODIS2') fname =trim(c_data)//'MODIS-Albedo2/MCD43GF_wsa_H11V13.nc' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + if(MA=='MODIS1') fname =trim(MAKE_BCS_INPUT_DIR)//'/land/albedo/snowfree/MODIS/v1/MODISalb.c004.v2.WS_H11V13.nc' + if(MA=='MODIS2') fname =trim(MAKE_BCS_INPUT_DIR)//'/land/albedo/snowfree/MODIS/v2/MCD43GF_wsa_H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'j_ind_offset_LL',jLL); VERIFY_(STATUS) @@ -1865,8 +1867,8 @@ SUBROUTINE modis_alb_on_tiles_high (nc_data,nr_data,rmap,MA,gfiler) do ix = 1,36 write (vv,'(i2.2)')jx write (hh,'(i2.2)')ix - if(MA=='MODIS1') fname =trim(c_data)//'MODIS-Albedo/MODISalb.c004.v2.WS_H'//hh//'V'//vv//'.nc' - if(MA=='MODIS2') fname =trim(c_data)//'MODIS-Albedo2/MCD43GF_wsa_H'//hh//'V'//vv//'.nc' + if(MA=='MODIS1') fname =trim(MAKE_BCS_INPUT_DIR)//'/land/albedo/snowfree/MODIS/v1/MODISalb.c004.v2.WS_H'//hh//'V'//vv//'.nc' + if(MA=='MODIS2') fname =trim(MAKE_BCS_INPUT_DIR)//'/land/albedo/snowfree/MODIS/v2/MCD43GF_wsa_H'//hh//'V'//vv//'.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid) if(status == 0) then status = NF_GET_att_INT (ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) @@ -1928,18 +1930,20 @@ END SUBROUTINE modis_alb_on_tiles_high ! ! --------------------------------------------------------------------------------------- ! - SUBROUTINE hres_lai (nx,ny,gfiler,c_data,lai_name,merge) + SUBROUTINE hres_lai (nx,ny,gfiler,lai_name,merge) ! ! Processing GEOLAND2/MODIS LAI and creating 10-day climatological data ! implicit none integer, intent (in) :: nx, ny - character(*) :: gfiler,c_data,lai_name + character(*) :: gfiler,lai_name + integer, intent(in), optional :: merge integer :: n,maxcat,i,j,k,ncid,i_highd,j_highd,nx_adj,ny_adj,ierr integer :: status,iLL,jLL,ix,jx,vid,nc_10,nr_10,n_tslices,d_undef,t, & time_slice,time_slice_next,yr,mn,dd,yr1,mn1,dd1,i1,i2 real :: dum, gyr,gmn,gdy,gyr1,gmn1,gdy1, slice1,slice2 - character*100 :: fname,fout + character*100 :: fout + character*200 :: fname character*10 :: string character*2 :: VV,HH integer, allocatable, dimension (:,:) :: & @@ -1956,7 +1960,6 @@ SUBROUTINE hres_lai (nx,ny,gfiler,c_data,lai_name,merge) logical :: first_entry = .true. type (date_time_type) :: bf_gswp2_time,af_gswp2_time,date_time_new,bf_lai_time, & af_lai_time - integer, intent(in), optional :: merge ! ! Reading number of cathment-tiles from catchment.def file !--------------------------------------------------------- @@ -1969,7 +1972,8 @@ SUBROUTINE hres_lai (nx,ny,gfiler,c_data,lai_name,merge) read(10,*) maxcat close (10,status='keep') - fname =trim(c_data)//trim(lai_name)//'lai_clim.H11V13.nc' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v2/'//trim(lai_name)//'lai_clim.H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'j_ind_offset_LL',jLL); VERIFY_(STATUS) @@ -2067,7 +2071,7 @@ SUBROUTINE hres_lai (nx,ny,gfiler,c_data,lai_name,merge) do ix = 1,36 write (vv,'(i2.2)')jx write (hh,'(i2.2)')ix - fname = trim(c_data)//trim(lai_name)//'lai_clim.H'//hh//'V'//vv//'.nc' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v2/'//trim(lai_name)//'lai_clim.H'//hh//'V'//vv//'.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid) if(status == 0) then status = NF_GET_att_INT (ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) @@ -2210,7 +2214,8 @@ SUBROUTINE grid2tile_modis6 (nc_data,nr_data,ncol,nrow,gfiler,lai_name) integer :: n,maxcat,i,j,k,ncid,i_highd,j_highd,nx_adj,ny_adj,ierr,nx,ny integer :: status,iLL,jLL,ix,jx,vid,nc_10,nr_10,n_tslices,d_undef,t, & time_slice,time_slice_next,yr,mn,dd,yr1,mn1,dd1,i1,i2,tindex1,pfaf1 - character*100 :: fname,fout + character*100 :: fout + character*200 :: fname character*10 :: string character*2 :: VV,HH integer, allocatable, target, dimension (:,:) :: net_data1 @@ -2264,7 +2269,8 @@ SUBROUTINE grid2tile_modis6 (nc_data,nr_data,ncol,nrow,gfiler,lai_name) end do close (10,status='keep') - fname =trim(c_data)//trim(lai_name)//'lai_clim.H11V13.nc' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v3/'//trim(lai_name)//'lai_clim.H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'j_ind_offset_LL',jLL); VERIFY_(STATUS) @@ -2350,7 +2356,7 @@ SUBROUTINE grid2tile_modis6 (nc_data,nr_data,ncol,nrow,gfiler,lai_name) do ix = 1,36 write (vv,'(i2.2)')jx write (hh,'(i2.2)')ix - fname = trim(c_data)//trim(lai_name)//'lai_clim.H'//hh//'V'//vv//'.nc' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v3/'//trim(lai_name)//'lai_clim.H'//hh//'V'//vv//'.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid) if(status == 0) then status = NF_GET_att_INT (ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) @@ -2453,10 +2459,12 @@ SUBROUTINE hres_lai_no_gswp (nc_data,nr_data,rmap,gfiler,lai_name, merge) integer :: QSize type (regrid_map), intent (in) :: rmap character(*) :: gfiler,lai_name + integer, intent(in), optional :: merge integer :: n,maxcat,i,j,k,ncid,i_highd,j_highd,nx_adj,ny_adj,ierr,nx,ny integer :: status,iLL,jLL,ix,jx,vid,nc_10,nr_10,n_tslices,d_undef,t, & time_slice,time_slice_next,yr,mn,dd,yr1,mn1,dd1,i1,i2,tindex1,pfaf1 - character*100 :: fname,fout + character*100 :: fout + character*200 :: fname character*10 :: string character*2 :: VV,HH integer, allocatable, target, dimension (:,:) :: net_data1 @@ -2472,7 +2480,6 @@ SUBROUTINE hres_lai_no_gswp (nc_data,nr_data,rmap,gfiler,lai_name, merge) logical :: first_entry = .true. type (date_time_type) :: date_time_new,bf_lai_time, & af_lai_time - integer, intent(in), optional :: merge ! Reading rst file !----------------- @@ -2502,7 +2509,8 @@ SUBROUTINE hres_lai_no_gswp (nc_data,nr_data,rmap,gfiler,lai_name, merge) end do close (10,status='keep') - fname =trim(c_data)//trim(lai_name)//'lai_clim.H11V13.nc' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v2/'//trim(lai_name)//'lai_clim.H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'j_ind_offset_LL',jLL); VERIFY_(STATUS) @@ -2595,7 +2603,7 @@ SUBROUTINE hres_lai_no_gswp (nc_data,nr_data,rmap,gfiler,lai_name, merge) do ix = 1,36 write (vv,'(i2.2)')jx write (hh,'(i2.2)')ix - fname = trim(c_data)//trim(lai_name)//'lai_clim.H'//hh//'V'//vv//'.nc' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v2/'//trim(lai_name)//'lai_clim.H'//hh//'V'//vv//'.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid) if(status == 0) then status = NF_GET_att_INT (ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) @@ -2776,7 +2784,8 @@ SUBROUTINE hres_gswp2 (nc_data,nr_data,rmap, gfiler,lai_name,merge) time_slice,time_slice_next,yr,mn,dd,yr1,mn1,dd1,i1,i2 type (regrid_map), intent (in) :: rmap real :: dum, gyr,gmn,gdy,gyr1,gmn1,gdy1, slice1,slice2 - character*100 :: fname,fout + character*100 :: fout + character*200 :: fname character*10 :: string character*2 :: VV,HH integer, allocatable, target, dimension (:,:) :: & @@ -2833,7 +2842,8 @@ SUBROUTINE hres_gswp2 (nc_data,nr_data,rmap, gfiler,lai_name,merge) close (10,status='keep') - fname =trim(c_data)//'GSWP2_30sec_VegParam/GSWP2_VegParam_H11V13.nc' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v1/GSWP2_VegParam_H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) status = NF_GET_att_INT(ncid,NF_GLOBAL,'j_ind_offset_LL',jLL); VERIFY_(STATUS) @@ -2899,7 +2909,7 @@ SUBROUTINE hres_gswp2 (nc_data,nr_data,rmap, gfiler,lai_name,merge) do ix = 1,36 write (vv,'(i2.2)')jx write (hh,'(i2.2)')ix - fname = trim(c_data)//'GSWP2_30sec_VegParam/GSWP2_VegParam_H'//hh//'V'//vv//'.nc' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v1/GSWP2_VegParam_H'//hh//'V'//vv//'.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid) if(status == 0) then status = NF_GET_att_INT (ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) @@ -3045,6 +3055,7 @@ SUBROUTINE MODIS_snow_alb ( ) close (10,status='keep') + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) ! ----------- Get the information on snow albedo ----- ! ----------- The information on snow albedo is stored in 10x10deg 30-arcsec resolution files. ! ----------- Read in this information, then loop over the tiles to find a corresponding snow albedo. @@ -3059,8 +3070,7 @@ SUBROUTINE MODIS_snow_alb ( ) ! MODIS-based climatology albedo raster files, backfilled with global land ! average snow albedo (=0.56; average excludes Antarctica and Greenland ice ! sheets and is weighted by the grid-cell area). - fname = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/albedo/snow/MODIS/v2/snow_alb_FillVal_MOD10A1.061_30arcsec_H'//hh//'V'//vv//'.nc' - + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/albedo/snow/MODIS/v2/snow_alb_FillVal_MOD10A1.061_30arcsec_H'//hh//'V'//vv//'.nc' ! Open the file. (NF90_NOWRITE ensures read-only access to the file) status=NF_OPEN(trim(fname),NF_NOWRITE, ncid) ; VERIFY_(STATUS) ! Based on vars name, get the varids. @@ -3161,7 +3171,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) implicit none integer, intent (in) :: nx, ny - character(*) :: gfiler + character(*) :: gfiler real, dimension (:), allocatable :: & a_sand,a_clay,a_silt,a_oc,a_bee,a_psis, & a_poros,a_wp,a_aksat,atau,btau,a_wpsurf,a_porosurf, & @@ -3173,7 +3183,8 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) integer :: n,maxcat,i,j,k,ktop,ncid,i_highd,j_highd,nx_adj,ny_adj integer :: status,iLL,jLL,ix,jx,vid,nc_10,nr_10,d_undef, & i1,i2,icount - character*100 :: fname,fout + character*100 :: fout + character*200 :: fname character*10 :: string character*2 :: VV,HH @@ -3211,6 +3222,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) REAL, DIMENSION (:), POINTER :: PMAP REAL, ALLOCATABLE, DIMENSION (:,:) :: PMAPR + ! --------- VARIABLES FOR *OPENMP* PARALLEL ENVIRONMENT ------------ ! ! NOTE: "!$" is for conditional compilation @@ -3299,7 +3311,8 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) ! ! get info common to all H[xx]V[yy] rectangles: - fname =trim(c_data)//'SOIL-DATA/GSWP2_soildepth_H11V13.nc' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_depth/v2/GSWP2_soildepth_H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) !status = NF_GET_att_INT(ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) ! cannot be needed here !status = NF_GET_att_INT(ncid,NF_GLOBAL,'j_ind_offset_LL',jLL); VERIFY_(STATUS) ! cannot be needed here @@ -3333,7 +3346,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) do ix = 1,36 write (vv,'(i2.2)')jx write (hh,'(i2.2)')ix - fname = trim(c_data)//'SOIL-DATA/GSWP2_soildepth_H'//hh//'V'//vv//'.nc' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_depth/v2/GSWP2_soildepth_H'//hh//'V'//vv//'.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid) if(status == 0) then status = NF_GET_att_INT (ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) @@ -3434,7 +3447,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) ! get info common to all H[xx]V[yy] rectangles (could in theory differ from that ! of soildepth data read above but is the same as of 29 Apr 2022). - fname =trim(c_data)//'SOIL-DATA/SoilProperties_H11V13.nc' + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_properties/v2/SoilProperties_H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) !status = NF_GET_att_INT(ncid,NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) ! cannot be needed here !status = NF_GET_att_INT(ncid,NF_GLOBAL,'j_ind_offset_LL',jLL); VERIFY_(STATUS) ! cannot be needed here @@ -3490,7 +3503,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) do ix = 1,36 write (vv,'(i2.2)')jx write (hh,'(i2.2)')ix - fname = trim(c_data)//'SOIL-DATA/SoilProperties_H'//hh//'V'//vv//'.nc' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_properties/v2/SoilProperties_H'//hh//'V'//vv//'.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid) if(status == 0) then status = NF_GET_att_INT (ncid, NF_GLOBAL,'i_ind_offset_LL',iLL); VERIFY_(STATUS) @@ -3542,7 +3555,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) if(use_PEATMAP) then print *, 'PEATMAP_THRESHOLD_1 : ', PEATMAP_THRESHOLD_1 allocate(pmapr (1:i_highd,1:j_highd)) - status = NF_OPEN ('data/CATCH/PEATMAP_mask.nc4', NF_NOWRITE, ncid) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/PEATMAP_mask.nc4', NF_NOWRITE, ncid) status = NF_GET_VARA_REAL (ncid,NC_VarID(NCID,'PEATMAP'), (/1,1/),(/i_highd, j_highd/), pmapr) ; VERIFY_(STATUS) ! move HWSD sub-surface peat to peat-rich mineral Group 3 because merged surface peat defines sub-surface peat @@ -3809,9 +3822,9 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) ! NLv5 3.79e-6 2.80e-5 <== note *typo* in Table 2 of Bechtold et al. 2019, which erroneously lists K_s=2.8e-5 if(use_PEATMAP) then - fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.peatmap' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/SoilClasses-SoilHyd-TauParam.peatmap' else - fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.dat' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/SoilClasses-SoilHyd-TauParam.dat' endif table_map = 0 ! 100-by-3 look-up table @@ -4630,6 +4643,9 @@ END FUNCTION center_pix_int0 ! INTEGER, ALLOCATABLE, dimension (:,:) :: tile_id ! character*100 :: fout ! +! character*300 :: MAKE_BCS_INPUT_DIR +! call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) +! ! ! Reading number of tiles ! ! ----------------------- ! @@ -4642,7 +4658,7 @@ END FUNCTION center_pix_int0 ! ! READ PEATMAP source data files and regrid ! ! ----------------------------------------- ! -! status = NF_OPEN ('data/CATCH/PEATMAP_mask.nc4', NF_NOWRITE, ncid) +! status = NF_OPEN (''//trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/PEATMAP_mask.nc4', NF_NOWRITE, ncid) ! ! allocate (pm_grid (1 : NC , 1 : NR)) ! allocate (data_grid (1 : N_lon_pm, 1 : N_lat_pm)) @@ -4755,6 +4771,7 @@ SUBROUTINE grid2tile_ndep_t2m_alb (irst,jrst,gfiler) integer :: i, j, n, im, jm, lwi, idum, ntiles, nland, nv, ix, jx, itype, iband, isum, ntl, np, jalbx, ialbx, ncid, status logical :: file_exists + ! read nland from catchment.def ! ----------------------------- @@ -4862,7 +4879,8 @@ SUBROUTINE grid2tile_ndep_t2m_alb (irst,jrst,gfiler) allocate(data_grid(iclm,jclm)) allocate(ndep_tile(nland)) - open(8,file='data/CATCH/CLSM-CN/ndep_clm_simyr2000_0.23x0.31_c091106.gdat', & + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + open(8,file=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/nitrogen_deposition/v1/ndep_clm_simyr2000_0.23x0.31_c091106.gdat', & form='unformatted',status='old') read(8) data_grid close(8) @@ -4922,7 +4940,7 @@ SUBROUTINE grid2tile_ndep_t2m_alb (irst,jrst,gfiler) allocate(data_grid(iprn,jprn)) allocate(t2mp_tile(nland)) - open(8,file='data/CATCH/CLSM-CN/princeton_annual_mean_T2m_1948-2012.gdat', & + open(8,file=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/annual_mean_T2m/v1/princeton_annual_mean_T2m_1948-2012.gdat', & form='unformatted',status='old') read(8) data_grid close(8) @@ -4981,7 +4999,7 @@ SUBROUTINE grid2tile_ndep_t2m_alb (irst,jrst,gfiler) allocate(data_grid(imra,jmra)) allocate(t2mm_tile(nland)) - open(8,file='data/CATCH/CLSM-CN/MERRA2_annual_mean_T2m_1980-2014.gdat', & + open(8,file=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/annual_mean_T2m/v1/MERRA2_annual_mean_T2m_1980-2014.gdat', & form='unformatted',status='old') read(8) data_grid close(8) @@ -5056,7 +5074,7 @@ SUBROUTINE grid2tile_ndep_t2m_alb (irst,jrst,gfiler) fill = 0.07 endif - open(8,file='data/CATCH/CLSM-CN/modis_'//ctype//'sa_soil_bb'//cband//'_cmg', & + open(8,file=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_albedo/v1/modis_'//ctype//'sa_soil_bb'//cband//'_cmg', & form='unformatted',status='old',access='direct',recl=ialb*jalb) read(8,rec=1) (data_grid(:,j), j = jalb,1,-1) ! data is from north to south where(data_grid <= 0.) data_grid = fill @@ -5171,6 +5189,7 @@ SUBROUTINE CREATE_ROUT_PARA_FILE (NC, NR, gfile, MGRID, deltaXY) integer, dimension(8) :: date_time_values character (22) :: time_stamp + ! Reading raster file allocate(raster (1:nc,1:nr)) @@ -5247,7 +5266,8 @@ SUBROUTINE CREATE_ROUT_PARA_FILE (NC, NR, gfile, MGRID, deltaXY) ! Now computing SMAP-cells to Pfafcatchment fractional areas - status = NF_OPEN ('data/CATCH/GEOS5_10arcsec_mask.nc', NF_NOWRITE, ncid_msk) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/GEOS5_10arcsec_mask.nc', NF_NOWRITE, ncid_msk) nbins = 1 allocate (pfaf_area (1:max_pfaf_smap)) @@ -5383,6 +5403,7 @@ SUBROUTINE CLM45_fixed_parameters (nc,nr,gfiler) a_poros,a_wp,a_aksat,atau,btau,a_wpsurf,a_porosurf, & atau_2cm,btau_2cm, field_cap (n_SoilClasses) + ! Reading number of tiles ! ----------------------- @@ -5395,10 +5416,11 @@ SUBROUTINE CLM45_fixed_parameters (nc,nr,gfiler) ! READ CLM4.5 source data files and regrid ! ---------------------------------------- - status = NF_OPEN ('data/CATCH/CLM45/clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc', NF_NOWRITE, ncid_hdm ) - status = NF_OPEN ('data/CATCH/CLM45/mksrf_abm_0.5x0.5_AVHRR_simyr2000.c130201.nc' , NF_NOWRITE, ncid_abm ) - status = NF_OPEN ('data/CATCH/CLM45/mksrf_gdp_0.5x0.5_AVHRR_simyr2000.c130228.nc' , NF_NOWRITE, ncid_gdp ) - status = NF_OPEN ('data/CATCH/CLM45/mksrf_peatf_0.5x0.5_AVHRR_simyr2000.c130228.nc' , NF_NOWRITE, ncid_peatf) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/misc/CLM45/clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc', NF_NOWRITE, ncid_hdm ) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/misc/CLM45/mksrf_abm_0.5x0.5_AVHRR_simyr2000.c130201.nc' , NF_NOWRITE, ncid_abm ) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/misc/CLM45/mksrf_gdp_0.5x0.5_AVHRR_simyr2000.c130228.nc' , NF_NOWRITE, ncid_gdp ) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/misc/CLM45/mksrf_peatf_0.5x0.5_AVHRR_simyr2000.c130228.nc' , NF_NOWRITE, ncid_peatf) allocate (hdm_grid (1:NC,1:NR)) allocate (abm_grid (1:NC,1:NR)) @@ -5490,7 +5512,7 @@ SUBROUTINE CLM45_fixed_parameters (nc,nr,gfiler) ! Field Capacity ! -------------- - open (11, file='data/CATCH/SoilClasses-SoilHyd-TauParam.dat', form='formatted',status='old', & + open (11, file=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/SoilClasses-SoilHyd-TauParam.dat', form='formatted',status='old', & action = 'read') read (11,'(a)')fout do i =1,n_SoilClasses @@ -5547,6 +5569,7 @@ SUBROUTINE CLM45_clim_parameters (nc,nr,gfiler) INTEGER, ALLOCATABLE, dimension (:,:) :: tile_id integer :: yr,mn,yr1,mn1, k,t,i,j + ! Reading number of tiles ! ----------------------- @@ -5575,7 +5598,8 @@ SUBROUTINE CLM45_clim_parameters (nc,nr,gfiler) ! READ CLM4.5 source data files and regrid ! ---------------------------------------- - status = NF_OPEN ('data/CATCH/CLM45/LISOTD_HRMC_V2.3.2014.nc4', NF_NOWRITE, ncid) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/misc/CLM45/LISOTD_HRMC_V2.3.2014.nc4', NF_NOWRITE, ncid) status = NF_INQ_VARID (ncid,'HRMC_COM_FR',VarID) ; VERIFY_(STATUS) allocate (hrmc_grid (1:NC,1:NR)) @@ -5637,7 +5661,8 @@ SUBROUTINE grid2tile_glass (ncol,nrow,gfiler,lai_name) integer :: n,maxcat,i,j,k,ncid,i_highd,j_highd,nx_adj,ny_adj,ierr,nx,ny integer :: status,iLL,jLL,ix,jx,vid,nc_10,nr_10,n_tslices,d_undef,t, & time_slice,time_slice_next,yr,mn,dd,yr1,mn1,dd1,i1,i2,tindex1,pfaf1 - character*100 :: fname,fout + character*100 :: fout + character*200 :: fname character*10 :: string character*2 :: VV,HH integer, allocatable, target, dimension (:,:) :: net_data1 @@ -5685,7 +5710,8 @@ SUBROUTINE grid2tile_glass (ncol,nrow,gfiler,lai_name) end do close (10,status='keep') - fname =trim(c_data)//'/MODIS_8-DayClim/MODIS_lai_clim.H11V13.nc' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + fname =trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v2/MODIS_8-DayClim/MODIS_lai_clim.H11V13.nc' status = NF_OPEN(trim(fname),NF_NOWRITE, ncid); VERIFY_(STATUS) status = NF_INQ_DIM (ncid,3,string, n_tslices); VERIFY_(STATUS) allocate (MMDD (0: n_tslices + 1)) @@ -5761,7 +5787,7 @@ SUBROUTINE grid2tile_glass (ncol,nrow,gfiler,lai_name) count_lai = 0. lai_grid = -9999 - status = NF_OPEN (trim(c_data)//trim(lai_name)//ddd//'.nc4', NF_NOWRITE, ncid) ; VERIFY_(STATUS) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/v4/'//trim(lai_name)//ddd//'.nc4', NF_NOWRITE, ncid) ; VERIFY_(STATUS) status = NF_INQ_VARID (ncid,'LAI',VarID) ; VERIFY_(STATUS) status = NF_GET_VARA_INT(ncid,VarID, (/1,1/),(/N_lon_glass, N_lat_glass/), net_data1) ; VERIFY_(STATUS) @@ -5866,6 +5892,7 @@ SUBROUTINE gimms_clim_ndvi (nc,nr,gfiler) integer, parameter :: scale_fac = 10000 real, parameter :: val_min = -0.3, val_max = 1. + ! Reading number of tiles ! ----------------------- @@ -5894,8 +5921,9 @@ SUBROUTINE gimms_clim_ndvi (nc,nr,gfiler) ! READ GIMMS NDVI source data files and regrid ! ---------------------------------------- - status = NF_OPEN ('data/CATCH/ndvi3g_geo_v1_YYYY_0106.nc4', NF_NOWRITE, ncid1) ; VERIFY_(STATUS) - status = NF_OPEN ('data/CATCH/ndvi3g_geo_v1_YYYY_0712.nc4', NF_NOWRITE, ncid2) ; VERIFY_(STATUS) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/ndvi/v1/ndvi3g_geo_v1_YYYY_0106.nc4', NF_NOWRITE, ncid1) ; VERIFY_(STATUS) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/ndvi/v1/ndvi3g_geo_v1_YYYY_0712.nc4', NF_NOWRITE, ncid2) ; VERIFY_(STATUS) status = NF_INQ_VARID (ncid2,'ndvi',VarID) ; VERIFY_(STATUS) allocate (ndvi_grid (1:NC,1:NR)) @@ -6156,6 +6184,7 @@ SUBROUTINE map_country_codes (NC, NR, gfiler) call get_country_codes (index_RANGE = index_RANGE, ST_NAME = ST_NAME, & CNT_NAME = CNT_NAME) + ! Reading number of tiles ! ----------------------- @@ -6169,7 +6198,8 @@ SUBROUTINE map_country_codes (NC, NR, gfiler) ! READ country code source data files and regrid ! ----------------------------------------- - status = NF_OPEN ('data/CATCH/GADM_Country_and_USStates_codes_1km.nc4', NF_NOWRITE, ncid) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/misc/country_codes/v1/GADM_Country_and_USStates_codes_1km.nc4', NF_NOWRITE, ncid) allocate (cnt_grid (1 : GC, 1 : GR)) allocate (st_grid (1 : GC, 1 : GR)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rasterize.F90 similarity index 94% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rasterize.F90 index 8a3370b26..c742a1f24 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rasterize.F90 @@ -1,11 +1,11 @@ - -#include "Raster.h" +#include "MAPL_ErrLog.h" module LogRectRasterizeMod use MAPL_SORTMOD use rmTinyCatchParaMod, ONLY: SRTM_maxcat - + use MAPL_ExceptionHandling + use MAPL_Constants, only: PI=>MAPL_PI_R8 implicit none private @@ -29,14 +29,13 @@ module LogRectRasterizeMod public WriteLine integer, parameter :: PUSHLEFT = 10000 - REAL_ , parameter :: Zero = 0.0 - REAL_ , parameter :: PI = RASTER_PI + real(kind=8) , parameter :: Zero = 0.0 integer, parameter :: NX = 8640 integer, parameter :: NY = 4320 - REAL_ :: garea_ + real(kind=8) :: garea_ integer :: ctg_ interface LRRasterize @@ -113,7 +112,7 @@ end subroutine ReadRaster subroutine SortTiling(Raster,rTable,iTable) integer, intent(INOUT) :: Raster(:,:), iTable(0:,:) - REAL_, intent(INOUT) :: rTable(:,:) + real(kind=8), intent(INOUT) :: rTable(:,:) integer, dimension(size(iTable,2)) :: old, new integer*8, dimension(size(iTable,2)) :: key, key0 @@ -163,15 +162,16 @@ subroutine SortTiling(Raster,rTable,iTable) return end subroutine SortTiling -subroutine WriteTilingIR(File, GridName, im, jm, ipx, nx, ny, iTable, rTable, Zip, Verb) +subroutine WriteTilingIR(File, GridName, im, jm, ipx, nx, ny, iTable, rTable, Zip, Verb, rc) character*(*), intent(IN) :: File character*(*), intent(IN) :: GridName(:) integer, intent(IN) :: nx,ny integer, intent(IN) :: iTable(0:,:) - REAL_, intent(IN) :: rTable(:,:) + real(kind=8), intent(IN) :: rTable(:,:) integer, intent(IN) :: IM(:), JM(:), ipx(:) logical, optional, intent(IN) :: Zip logical, optional, intent(IN) :: Verb + integer, optional, intent(out) :: rc ! Table variables ! @@ -192,10 +192,11 @@ subroutine WriteTilingIR(File, GridName, im, jm, ipx, nx, ny, iTable, rTable, Zi integer :: j, unit, ng, ip, l, i, k, ix character*1000 :: Line integer :: ii(size(GridName)), jj(size(GridName)), kk(size(GridName)) - REAL_ :: fr(size(GridName)) - REAL_ :: xc, yc, area - REAL_ :: garea, ctg(size(Gridname)) - REAL_ :: sphere, error + real(kind=8) :: fr(size(GridName)) + real(kind=8) :: xc, yc, area + real(kind=8) :: garea, ctg(size(Gridname)) + real(kind=8) :: sphere, error + integer :: status ip = size(iTable,2) ng = size(GridName) @@ -388,7 +389,7 @@ subroutine WriteLine(File, Unit, iTable, rTable, k, Zip, Verb) character*(*), intent(IN) :: File integer, intent(IN) :: Unit, k integer, intent(IN) :: iTable(0:) - REAL_, intent(IN) :: rTable(:) + real(kind=8), intent(IN) :: rTable(:) logical, optional, intent(IN) :: Zip logical, optional, intent(IN) :: Verb @@ -410,8 +411,8 @@ subroutine WriteLine(File, Unit, iTable, rTable, k, Zip, Verb) logical :: DoZip character*1000 :: Line integer :: ii, jj - REAL_ :: fr - REAL_ :: xc, yc, area + real(kind=8) :: fr + real(kind=8) :: xc, yc, area if(present(Zip)) then DoZip = Zip @@ -477,7 +478,7 @@ subroutine CloseTiling(FIle, Unit, ip, Zip, Verb) ! rTable(5) :: of 2nd grid box area logical :: DoZip - REAL_ :: sphere, error + real(kind=8) :: sphere, error character*1000 :: Line Line="" diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.H b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rasterize.H similarity index 87% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.H rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rasterize.H index e8c6bbde0..f2cf014ab 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.H +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rasterize.H @@ -1,6 +1,4 @@ - - #ifdef MESH #define LRRasterize2Mem LRRasterize2Mem0 #define LRRasterize2File LRRasterize2File0 @@ -8,12 +6,13 @@ #else #define POLYSIZE size(xv,3) #endif +#define RASTERUNDEF -999 !BOP ! !IROUTINE: LRRasterize -- Rasterizes a 2-D array of polygons. subroutine LRRasterize2File(GridName, xv,yv,nc,nr,xmn,xmx,ymn,ymx, & - SurfaceType, Verb, Here,jseg, tol ) + SurfaceType, Verb, Here,jseg, tol, rc ) ! This routine rasterizes a grid defined by a 2-D array of polygons. ! The raster value assigned each pixel is either sign((I*pushleft + J),sgn), @@ -55,22 +54,23 @@ character*(*), intent(INOUT) :: GridName ! Raster file name #ifdef MESH - REAL_, intent(INOUT) :: xv(:,:) ! X coordinates of vertices - REAL_, intent(INOUT) :: yv(:,:) ! Y coordinates of vertices + real(kind=8), intent(INOUT) :: xv(:,:) ! X coordinates of vertices + real(kind=8), intent(INOUT) :: yv(:,:) ! Y coordinates of vertices #else - REAL_, intent(INOUT) :: xv(:,:,:) ! X coordinates of vertices - REAL_, intent(INOUT) :: yv(:,:,:) ! Y coordinates of vertices + real(kind=8), intent(INOUT) :: xv(:,:,:) ! X coordinates of vertices + real(kind=8), intent(INOUT) :: yv(:,:,:) ! Y coordinates of vertices #endif integer, optional, intent(IN) :: nc,nr ! Raster field sizes - REAL_, optional, intent(IN) :: xmn ! LL x of LL raster cell (-180) - REAL_, optional, intent(IN) :: ymn ! LL y of LL raster cell ( -90) - REAL_, optional, intent(IN) :: xmx ! UR x of UR raster cell ( 180) - REAL_, optional, intent(IN) :: ymx ! UR y of UR raster cell ( 90) + real(kind=8), optional, intent(IN) :: xmn ! LL x of LL raster cell (-180) + real(kind=8), optional, intent(IN) :: ymn ! LL y of LL raster cell ( -90) + real(kind=8), optional, intent(IN) :: xmx ! UR x of UR raster cell ( 180) + real(kind=8), optional, intent(IN) :: ymx ! UR y of UR raster cell ( 90) logical, optional, intent(IN) :: verb ! Verbose logical, optional, intent(IN) :: here ! write here integer, optional, intent(IN) :: SurfaceType integer, optional, intent(IN) :: jseg - REAL_, optional :: tol + real(kind=8), optional :: tol + integer, optional, intent(out) :: rc character*(128) :: TileFile character*(128) :: TilDir='', RstDir='' @@ -172,7 +172,7 @@ subroutine LRRasterize2Mem(Raster,xv,yv,Tilefile, & xmn,xmx,ymn,ymx, & - SurfaceType,verb,jseg, tol ) + SurfaceType,verb,jseg, tol, rc ) ! This routine rasterizes a grid defined by a 2-D array of polygons. ! The raster value assigned is an index to the table. @@ -191,41 +191,42 @@ integer, intent(INOUT) :: Raster(:,:) ! Raster field to be filled #ifdef MESH - REAL_, intent(INOUT) :: xv(:,: ) ! X coordinates of vertices - REAL_, intent(INOUT) :: yv(:,: ) ! Y coordinates of vertices + real(kind=8), intent(INOUT) :: xv(:,: ) ! X coordinates of vertices + real(kind=8), intent(INOUT) :: yv(:,: ) ! Y coordinates of vertices #else - REAL_, intent(INOUT) :: xv(:,:,:) ! X coordinates of vertices - REAL_, intent(INOUT) :: yv(:,:,:) ! Y coordinates of vertices + real(kind=8), intent(INOUT) :: xv(:,:,:) ! X coordinates of vertices + real(kind=8), intent(INOUT) :: yv(:,:,:) ! Y coordinates of vertices #endif character*(*), intent(IN ) :: TileFile - REAL_, optional, intent(IN) :: xmn ! LL x of LL raster cell (-180) - REAL_, optional, intent(IN) :: ymn ! LL y of LL raster cell ( -90) - REAL_, optional, intent(IN) :: xmx ! UR x of UR raster cell ( 180) - REAL_, optional, intent(IN) :: ymx ! UR y of UR raster cell ( 90) + real(kind=8), optional, intent(IN) :: xmn ! LL x of LL raster cell (-180) + real(kind=8), optional, intent(IN) :: ymn ! LL y of LL raster cell ( -90) + real(kind=8), optional, intent(IN) :: xmx ! UR x of UR raster cell ( 180) + real(kind=8), optional, intent(IN) :: ymx ! UR y of UR raster cell ( 90) logical, optional, intent(IN) :: verb ! Verbose integer, optional, intent(IN) :: SurfaceType integer, optional, intent(IN) :: jseg - REAL_, optional :: tol + real(kind=8), optional :: tol + integer, optional, intent(out) :: rc ! X abd Y bounds of each polygon - REAL_ :: xmin, xmax - REAL_ :: ymin, ymax - REAL_ :: minx, miny - REAL_ :: maxx, maxy + real(kind=8) :: xmin, xmax + real(kind=8) :: ymin, ymax + real(kind=8) :: minx, miny + real(kind=8) :: maxx, maxy ! x and y coordinates of the Raster grid - REAL_, dimension(size(Raster,1)) :: xs, xcs, xss - REAL_, dimension(size(Raster,2)) :: ys, ycs, yss, da + real(kind=8), dimension(size(Raster,1)) :: xs, xcs, xss + real(kind=8), dimension(size(Raster,2)) :: ys, ycs, yss, da integer :: IM, JM, NV ! Shape of input grid - REAL_ :: dx, dy, dxi, dyi ! Grid spacing of raster grid + real(kind=8) :: dx, dy, dxi, dyi ! Grid spacing of raster grid integer :: xsize, ysize ! Dimensions of Raster grid integer :: i, j, jn, n, ib, jb, fill, uType, js, k - REAL_ :: range, d2r, r2d, ddx, grid_ymin, grid_ymax, xc, yc, Area, xx + real(kind=8) :: range, d2r, r2d, ddx, grid_ymin, grid_ymax, xc, yc, Area, xx logical :: DoZip, uVerb integer :: idx, ct integer :: count0,count1,count_rate @@ -234,18 +235,18 @@ character*(128) :: GridName, TilFile integer, allocatable :: iTable(:,:) - REAL_, allocatable :: rTable(:,:) + real(kind=8), allocatable :: rTable(:,:) integer :: useg, unit, fq integer, dimension(POLYSIZE) & :: nxt - REAL_, dimension(POLYSIZE) & + real(kind=8), dimension(POLYSIZE) & :: xvc, yvc, xvs, yvs, xrd, yrd, x3, y3, z3, & dx3, dy3, dz3, x31, x32, y31, y32, z31, z32, & dx4, dy4, x4, y4, xu, yu - REAL_ :: tol_ + real(kind=8) :: tol_ ! Process optionals @@ -343,8 +344,8 @@ dxi = 1.0/dx dyi = 1.0/dy - d2r = (2._8*RASTER_PI)/range - r2d = range/(2._8*RASTER_PI) + d2r = (2._8*PI)/range + r2d = range/(2._8*PI) ! Report @@ -557,14 +558,14 @@ subroutine FillPoly(sh) - REAL_, intent(IN) :: sh + real(kind=8), intent(IN) :: sh logical :: IsIn integer :: i1, i2, jj1 integer :: ii, jj, n1, n2, jx integer, save :: j1, j2 integer :: HALO=10 - REAL_ :: x0, y0 + real(kind=8) :: x0, y0 if (abs(miny+90._8) < 1.e-10_8) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/read_riveroutlet.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/read_riveroutlet.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/read_riveroutlet.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/read_riveroutlet.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 similarity index 98% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 index 8e4a16005..9171524e6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 @@ -7,8 +7,7 @@ module rmTinyCatchParaMod - use date_time_util - use leap_year + use LDAS_DateTimeMod use MAPL_ConstantsMod use MAPL_Base, ONLY: MAPL_UNDEF use lsm_routines, ONLY: sibalb @@ -28,8 +27,6 @@ module rmTinyCatchParaMod logical, parameter :: bug =.false. include 'netcdf.inc' logical :: preserve_soiltype = .false. - character*100 :: c_data = 'data/CATCH/' - private @@ -41,8 +38,9 @@ module rmTinyCatchParaMod public i_raster, j_raster,regridraster1,regridraster2,n_SoilClasses,zks public mineral_perc, process_gswp2_veg,center_pix, soil_class public tgen, sat_param,REFORMAT_VEGFILES,base_param,ts_param - public :: Get_MidTime, Time_Interp_Fac, compute_stats, c_data + public :: Get_MidTime, Time_Interp_Fac, compute_stats public :: ascat_r0, jpl_canoph, NC_VarID, init_bcs_config + public :: MAKE_BCS_INPUT_DIR INTEGER, PARAMETER, public:: SRTM_maxcat = 291284 @@ -56,6 +54,7 @@ module rmTinyCatchParaMod character*6, public, save :: MODALB = 'UNDEF' character*8, public, save :: SNOWALB = 'UNDEF' REAL, public, save :: GNU = MAPL_UNDEF + character*400 :: MAKE_BCS_INPUT_DIR type :: mineral_perc real :: clay_perc @@ -301,7 +300,8 @@ SUBROUTINE process_gswp2_veg (nc,nr,regrid,vname,gridnamer,merge) logical :: regrid integer, pointer :: Raster(:,:) character(*) :: vname,gridnamer - character *100 :: fname + character*100 :: fname + integer, intent(in), optional :: merge open (10,file=trim(gridnamer)//'.rst',status='old',action='read', & @@ -315,7 +315,8 @@ SUBROUTINE process_gswp2_veg (nc,nr,regrid,vname,gridnamer,merge) end do close (10,status='keep') - open (10,file=trim(c_data)//'gswp2_mask_2.5.rst',& + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/shared/mask/mapping_2.5_grid_to_gswp2_tile_index.rst',& form='unformatted',status='old',action='read',convert='little_endian') do j =1,j_raster @@ -347,7 +348,7 @@ SUBROUTINE process_gswp2_veg (nc,nr,regrid,vname,gridnamer,merge) mon_climate(:,:)=0. - iret = NF_OPEN(trim(c_data)//trim(vname)//'_uk.nc',NF_NOWRITE, ncid) + iret = NF_OPEN(trim(MAKE_BCS_INPUT_DIR)//'/land/veg/lai_grn/'//trim(vname)//'_uk.nc',NF_NOWRITE, ncid) ASSERT_(iret==NF_NOERR) @@ -491,7 +492,8 @@ SUBROUTINE modis_lai (nx,ny,regrid,gfile) allocate (lai (1:ncatch)) allocate (count (1:ncatch)) -fname = 'data/CATCH/MODIS_8-DayClim/' & +call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) +fname = trim(MAKE_BCS_INPUT_DIR)//'/MODIS_8-DayClim/' & //'MOD15A2.YYYY.12.27.global_2.5min.data' !write (*,'(a120)')trim(fname) @@ -551,7 +553,7 @@ SUBROUTINE modis_lai (nx,ny,regrid,gfile) dy1= after_time%day write (mmdd,'(i2.2,a1,i2.2)'),mn,'.',dy - fname ='data/CATCH/MODIS_8-DayClim/' & + fname =trim(MAKE_BCS_INPUT_DIR)//'/MODIS_8-DayClim/' & //'MOD15A2.YYYY.'//mmdd//'.global_2.5min.data' open (20,file=trim(fname),form='unformatted',convert='little_endian', & @@ -597,7 +599,7 @@ SUBROUTINE modis_lai (nx,ny,regrid,gfile) end do end do -fname = 'data/CATCH/MODIS_8-DayClim/' & +fname = trim(MAKE_BCS_INPUT_DIR)//'/MODIS_8-DayClim/' & //'MOD15A2.YYYY.01.01.global_2.5min.data' !write (*,'(a120)')trim(fname) @@ -675,6 +677,7 @@ SUBROUTINE soil_para_high (nx,ny,regrid,gfile,F25Tag) logical :: file_exists real, allocatable, dimension (:,:) :: parms4file + ! --------- VARIABLES FOR *OPENMP* PARALLEL ENVIRONMENT ------------ ! ! NOTE: "!$" is for conditional compilation @@ -777,9 +780,11 @@ SUBROUTINE soil_para_high (nx,ny,regrid,gfile,F25Tag) close (10,status='keep') + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + if (present(F25Tag)) then - iret = NF_OPEN('data/CATCH/SoilDepth.nc',NF_NOWRITE, ncid1) + iret = NF_OPEN(trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_depth/v1/SoilDepth.nc',NF_NOWRITE, ncid1) ASSERT_(iret==NF_NOERR) allocate (soildepth_gswp2(1: ncat_gswp2)) allocate (land_gswp2 (1: ncat_gswp2)) @@ -803,7 +808,7 @@ SUBROUTINE soil_para_high (nx,ny,regrid,gfile,F25Tag) deallocate (soildepth_gswp2,land_gswp2) else - open (10,file='data/CATCH/soil_depth_2.5.rst',& + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_depth/v1/soil_depth_2.5.rst',& form='unformatted',status='old',action='read',convert='little_endian') do j =1,j_raster @@ -1439,6 +1444,7 @@ SUBROUTINE modis_alb_on_tiles (nx,ny,ease_grid,regrid,gfilet,gfiler) raster => alb_in end if + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) do ialbt = 2,2 do ialbs = 1,2 do yy = 2005,2005 @@ -1450,7 +1456,7 @@ SUBROUTINE modis_alb_on_tiles (nx,ny,ease_grid,regrid,gfilet,gfiler) if(ialbs.eq.1)albspec='0.3_0.7/' if(ialbs.eq.2)albspec='0.7_5.0/' - ifile=trim(c_data)//'AlbMap.'//bw//'.2x5.'//trim(cyy)// & + ifile=trim(MAKE_BCS_INPUT_DIR)//'/land/albedo/AlbMap.'//bw//'.2x5.'//trim(cyy)// & '.monthly.'//albspec(1:index(albspec,'/')-1)//'.dat' ofile='clsm/AlbMap.'//bw//'.2x5.'//trim(cyy)//'.monthly-tile.' & //albspec(1:index(albspec,'/')-1)//'.dat' @@ -1958,7 +1964,8 @@ SUBROUTINE catchment_def (nx,ny,regrid,dateline,gfilet,gfiler) REAL :: lat,lon,fr_gcm,fr_cat,tarea INTEGER :: typ,pfs,ig,jg,j_dum,ierr,indx_dum,indr1,indr2,indr3 ,ip2 REAL (kind=8), PARAMETER :: RADIUS=MAPL_RADIUS,pi= MAPL_PI - character*100 :: path,fname,fout,metpath,gtopo30 + character*100 :: path,fname,fout,metpath + character*200 :: gtopo30 character (*) :: gfilet,gfiler character*10 :: dline CHARACTER*20 :: version,resoln,continent @@ -1972,7 +1979,8 @@ SUBROUTINE catchment_def (nx,ny,regrid,dateline,gfilet,gfiler) character*2 :: dateline real*4, allocatable , target :: q0 (:,:) - gtopo30 = 'data/CATCH/srtm30_withKMS_2.5x2.5min.data' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + gtopo30 = trim(MAKE_BCS_INPUT_DIR)//'/land/topo/v1/srtm30_withKMS_2.5x2.5min.data' allocate (q0(1:i_raster,1:j_raster)) i_sib = nx @@ -2200,7 +2208,7 @@ SUBROUTINE create_soil_types_files (nx,ny,ease_grid,gfilet,gfiler) INTEGER IDVAL,STEX INTEGER (kind=1), allocatable :: gtext(:,:) INTEGER irrecs, c1,c2,r1,r2 - CHARACTER*100 ifile,ifile2,ofile1,ofile2,fname + CHARACTER*200 ifile,ifile2,ofile1,ofile2,fname CHARACTER (*) :: gfiler,gfilet character*10 :: dline CHARACTER*20 :: version,resoln @@ -2259,8 +2267,11 @@ SUBROUTINE create_soil_types_files (nx,ny,ease_grid,gfilet,gfiler) allocate(catid(1:nx,1:ny)) catid =0 - ifile=trim(c_data)//'dtex_tp1.bin' - ifile2=trim(c_data)//'dtex_sb1.bin' + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + + + ifile=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_properties/v1/'//'dtex_tp1.bin' + ifile2=trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/soil_properties/v1/'//'dtex_sb1.bin' ofile1='clsm/soil_text.top' ofile2='clsm/soil_text.com' @@ -2530,7 +2541,8 @@ SUBROUTINE compute_mosaic_veg_types (nx,ny,ease_grid,regrid,gfilet,gfiler) allocate(sib_veg2(1:i_raster,1:j_raster)) allocate(sib_veg (1:i_raster,1:j_raster)) - open (10,file=trim(c_data)//'sib22.5_v2.0.dat',form='unformatted', & + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/veg/pft/v1/sib22.5_v2.0.dat',form='unformatted', & status='old',action='read',convert='big_endian') READ(10)sib_veg2 @@ -2764,7 +2776,6 @@ SUBROUTINE cti_stat_file (ease_grid,gfile, MaskFile) character*100 :: fname character(*) :: gfile character(*) :: MaskFile - ! fname=trim(gfile)//'.til' open (10,file=fname,status='old',action='read',form='formatted') @@ -2802,11 +2813,12 @@ SUBROUTINE cti_stat_file (ease_grid,gfile, MaskFile) allocate(colin2cat(1:6000000)) colin2cat=0 + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) if (index(MaskFile,'GEOS5_10arcsec_mask') /= 0) then - open (10,file=trim(c_data)//'/SRTM-TopoData/Pfafcatch-routing.dat', & + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat', & form='formatted', status='old',action='read') else - open (10,file=trim(c_data)//'/catchment.def', & + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/misc/old_land/catchment.def', & form='formatted', status='old',action='read') endif @@ -2822,10 +2834,10 @@ SUBROUTINE cti_stat_file (ease_grid,gfile, MaskFile) close (10,status='keep') if (index(MaskFile,'GEOS5_10arcsec_mask') /= 0) then - open (10,file=trim(c_data)//'/SRTM-TopoData/SRTM_cti_stats.dat', & + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/topo/v1/SRTM-TopoData/SRTM_cti_stats.dat', & form='formatted', status='old',action='read') else - open (10,file=trim(c_data)//'/cti_stats.dat', & + open (10,file=trim(MAKE_BCS_INPUT_DIR)//'/land/misc/old_land/cti_stats.dat', & form='formatted', status='old',action='read') endif @@ -2905,7 +2917,7 @@ SUBROUTINE create_model_para (MaskFile) real, allocatable, dimension (:,:,:,:) :: & gwatdep,gwan,grzexcn,gfrc real :: wtdep,wanom,rzaact,fracl,profdep,dist_save,tile_distance - character*100 :: pathout,fname,fout,losfile + character*200 :: pathout,fname,fout,losfile character*10 :: dline CHARACTER*20 :: version,resoln,continent character*6 rdep,ext @@ -2961,7 +2973,9 @@ SUBROUTINE create_model_para (MaskFile) ! ----------- OpenMP PARALLEL ENVIRONMENT ---------------------------- !c------------------------------------------------------------------------- - losfile =trim(c_data)//'GSWP2_loss_perday/loss_perday' + + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + losfile =trim(MAKE_BCS_INPUT_DIR)//'/land/soil/soil_water_loss/v1/loss_perday' !c opening files @@ -3589,7 +3603,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) gwatdep,gwan,grzexcn,gfrc real :: wtdep,wanom,rzaact,fracl,profdep,dist_save, & ncells_top, ncells_top_pro,ncells_sub_pro,tile_distance - character*100 :: pathout,fname,fout,losfile + character*200 :: pathout,fname,fout,losfile character*10 :: dline CHARACTER*20 :: version,resoln,continent character*6 rdep,ext @@ -3654,16 +3668,18 @@ SUBROUTINE create_model_para_woesten (Maskfile) ! NLv4 7.86e-7 5.81e-6 ! NLv5 3.79e-6 2.80e-5 <== note *typo* in Table 2 of Bechtold et al. 2019, which erroneously lists K_s=2.8e-5 + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + if(use_PEATMAP) then - fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.peatmap' + fname = trim(MAKE_BCS_INPUT_DIR)//'/land/soil/SOIL-DATA/SoilClasses-SoilHyd-TauParam.peatmap' else - fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.dat' + fname = trim(MAKE_BCS_INPUT_DIR)//'land/soil/SOIL-DATA/SoilClasses-SoilHyd-TauParam.dat' endif open (11, file=trim(fname), form='formatted',status='old', & action = 'read') read (11,'(a)')fout ! read header line - losfile =trim(c_data)//'/Woesten_SoilParam/loss_pd_top/loss_perday_rz1m_' + losfile =trim(MAKE_BCS_INPUT_DIR)//'/land/soil/soil_water_loss/v2/loss_pd_top/loss_perday_rz1m_' allocate (a_sand (1:n_SoilClasses)) allocate (a_silt (1:n_SoilClasses)) @@ -7412,7 +7428,8 @@ SUBROUTINE ascat_r0 (nc,nr,gfiler, z0) ! READ ASCAT source data and regrid ! --------------------------------- - status = NF_OPEN ('data/CATCH/arlems-roughness.x3600_y1800_t1.nc4', NF_NOWRITE, ncid) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/misc/roughness_length/v1/arlems-roughness.x3600_y1800_t1.nc4', NF_NOWRITE, ncid) allocate (z0_grid (1 : NC , 1 : NR)) allocate (data_grid (1 : N_lon_ascat, 1 : N_lat_ascat)) @@ -7476,7 +7493,7 @@ SUBROUTINE jpl_canoph (nc,nr,gfiler, z2) implicit none ! 1) JPL Canopy Height - ! /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001//Simard_Pinto_3DGlobalVeg_JGR.nc4 + ! /discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/veg/veg_height/v1/Simard_Pinto_3DGlobalVeg_JGR.nc4 integer, intent (in) :: nc, nr real, pointer, dimension (:), intent (inout) :: z2 @@ -7501,7 +7518,8 @@ SUBROUTINE jpl_canoph (nc,nr,gfiler, z2) ! READ JPL source data files and regrid ! ------------------------------------- - status = NF_OPEN ('data/CATCH/Simard_Pinto_3DGlobalVeg_JGR.nc4', NF_NOWRITE, ncid) + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + status = NF_OPEN (trim(MAKE_BCS_INPUT_DIR)//'/land/veg/veg_height/v1/Simard_Pinto_3DGlobalVeg_JGR.nc4', NF_NOWRITE, ncid) allocate (z2_grid (1 : NC , 1 : NR)) allocate (data_grid (1 : N_lon_jpl, 1 : N_lat_jpl)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/util.c b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/util.c similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/util.c rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/util.c diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/zip.c b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/zip.c similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/zip.c rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/zip.c diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/README b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/README new file mode 100644 index 000000000..c1af76617 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/README @@ -0,0 +1,2 @@ +Directory [..]/GEOSsurface_GridComp/Utils/Raster/misc contains miscellaneous debugging and plotting scripts. + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/chk_clsm_params.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/chk_clsm_params.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/compare_bcs.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/compare_bcs.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/compare_bcs.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/compare_bcs.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/get_frac.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/get_frac.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/get_frac.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/get_frac.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/modis_scale_factor.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/modis_scale_factor.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/modis_scale_factor.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/modis_scale_factor.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mosaic_classes_on_tiles.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/mosaic_classes_on_tiles.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mosaic_classes_on_tiles.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/mosaic_classes_on_tiles.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.csh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/plot_curves.csh similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.csh rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/plot_curves.csh diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/plot_curves.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/plot_curves.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_geos5_grid.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/plot_geos5_grid.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_geos5_grid.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/plot_geos5_grid.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/soil_types_on_tiles.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/soil_types_on_tiles.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/soil_types_on_tiles.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/soil_types_on_tiles.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/ConvertAlb.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/ConvertAlb.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/asia_tiles.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/asia_tiles.pro similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/asia_tiles.pro rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/asia_tiles.pro diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/compile_mk_runoff b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/compile_mk_runoff similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/compile_mk_runoff rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/compile_mk_runoff diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_tiles b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/make_tiles similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_tiles rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/make_tiles diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/mkLISTilesPara.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/mkLISTilesPara.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/rmTinyTiles.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/obsolete/rmTinyTiles.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt new file mode 100644 index 000000000..15405d696 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt @@ -0,0 +1 @@ +esma_add_subdirectories (soil) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/README b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/README new file mode 100644 index 000000000..efe175265 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/README @@ -0,0 +1 @@ +Directory [..]/GEOSsurface_GridComp/Utils/Raster/preproc/ contains programs and scripts needed to generate *input* files for make_bcs. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/get_lat_lon4tils.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/get_lat_lon4tils.pro new file mode 100755 index 000000000..bdb3558b3 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/get_lat_lon4tils.pro @@ -0,0 +1,81 @@ +pro get_lat_lon4tils + +; code to derive lat/lons for each MOD10A1 grid point. The code +; loops over MODIS files (hereinafter refered to as tiles), its +; grid boxes and calculates lat/lon values using the same approach +; as given in C function provided by MODIS team (publically available). +; The lat/lon values for each gridbox are written out in 10-degx10-deg files +; (to match MODIS files; each 2400x2400 elements), as well as in two +; global files holding lat and lon each. The code will print +; out even the tiles (and gridboxes) with no valid data (miss val:-999.) + +; to run in terminal window: +; type 'idl', then 'r. get_lat_lon4tils', then 'get_lat_lon4tils' +; requirements: a subdirectory 'MODIS_lat_lon' in the local space +; created: March 2022 Biljana Orescanin SSAI@NASA + +mis_val=-999. + +lat_stiched=make_array(2400l*36, 2400l*18, value=mis_val,/float) +lon_stiched=make_array(2400l*36, 2400l*18, value=mis_val,/float) ; Array[864, 432] + +; Set Map projection +sinusMap = MAP_PROJ_INIT('Sinusoidal', DATUM=8, CENTER_LAT=0., CENTER_LON=0,SPHERE_RADIUS=6371007.181) + +; loop over MOIDS tiles +for ivtil=0,18-1 do begin + for ihtil=0,36-1 do begin + + ; get 2-digit strings for vert and horiz tile/file numbering + v_str=strmid('0'+strtrim(ivtil,2),1,2,/reverse) + h_str=strmid('0'+strtrim(ihtil,2),1,2,/reverse) + + ; declare 2D arays to store lat/lons for the current file + lat2d=make_array(2400l, 2400l, value=mis_val,/float) ; fltarr(2400,2400) + lon2d=make_array(2400l, 2400l, value=mis_val,/float) ; + + ; loop over grid boxes within the current file + for ivgrid=0,2400-1 do begin + for ihgrid=0,2400-1 do begin + + ; get lats and lons from UV coordinates (requires the map projection loaded above) + xOrigin=-20015109.354d +((ihtil)*2400l+ihgrid)*463.31271653d + yOrigin= 10007554.677d -((ivtil)*2400l+ivgrid)*463.31271653d + lonlat = MAP_PROJ_INVERSE([xOrigin], [yOrigin], MAP_STRUCTURE=sinusMap) + lat =lonlat[1] + lon =lonlat[0] + + if lat eq lat then begin + lat2d(ihgrid,ivgrid)=lat + lon2d(ihgrid,ivgrid)=lon + i_ind=(ihtil)*2400l+ihgrid + j_ind=(ivtil)*2400l+ivgrid + lat_stiched(i_ind,j_ind)=lat + lon_stiched(i_ind,j_ind)=lon + endif + + endfor ; ihgrid + endfor ; ivgrid + + ;write 2D lat/lons into binary file + openw, 10, 'MODIS_lat_lon/MODIS_hdres_lat_lon_v'+v_str+'_h'+h_str+'.bin.gz', /compress + writeu,10, lat2D,lon2D + close, 10 + + ; place the current tile in global gird + lat_stiched((ihtil)*2400l:(ihtil)*2400l+2399,(ivtil)*2400l:(ivtil)*2400l+2399l)=lat2d + lon_stiched((ihtil)*2400l:(ihtil)*2400l+2399,(ivtil)*2400l:(ivtil)*2400l+2399l)=lon2d + + endfor ; ihtil +endfor ; ivril + +; write stiched lat/lons into a text file +openw , 20, 'MODIS_lat_lon/MODIS_lat_stiched_hdres_global.txt.gz', /compress +printf, 20, lat_stiched +close , 20 + +openw , 30, 'MODIS_lat_lon/MODIS_lon_stiched_hdres_global.txt.gz', /compress +printf, 30, lon_stiched +close , 30 + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/get_snow_alb_mod10a1_30arcsec.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/get_snow_alb_mod10a1_30arcsec.pro new file mode 100755 index 000000000..487fe8c4d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/get_snow_alb_mod10a1_30arcsec.pro @@ -0,0 +1,569 @@ +pro get_snow_alb_mod10a1_30arcsec, year=year, h_s=h_s, h_e=h_e + +; Code to stitch MODIS files, such as: MOD10A1.A2022002.h35v08.006.2022004050029.hdf +; into a static global 30arcsec grid and produce inputs for GEOS make_bcs package, such as: +; snow_alb_MOD10A1.061_30arcsec_H36V05.nc +; The original MODIS input files are on a sinusoidal (~500-m) grid. The final snow albedo +; product is on a 30arcsec regular lat/lon grid (date-line-edge and pole-edge) + +; It first reads the MODIS-tile files to generate snow cover PDFs over a period of time. +; These PDFs are made based on grid cells that exceed a snow cover value (e.g. 60%). This is done +; so a decent amount of snow over a grid box ensures a better estimate of albedo. +; The PDFs are then used to locate a user-defined cutoff for a %ile of snow coverage +; (e.g. top 10 %tile) and filter snow albedo values. + +; Input argument 'year' in the call specifies for what year(s) to run the code (to allow multiple +; serial runs). Only the PDF building can be processed using multiple serial runs, the remainder +; of the code has to execute on a single CPU. If no year(s) is provided on the input, the default +; year is used. Input argument can be an integer or an array of integers indicating year(s) to +; process (e.g. year=[2019,2020,2021]) + +; Input arguments 'h_s' and 'h_e' are starting and ending horizontal tiles. These are optional +; and if provided define the range of horizontal MODIS tiles to be processed (it saves time if +; certain tiles need re-processing; otherwise should be ignored) + +; dependencies: +; grid.pro (performes gridding) +; read_hdf_sd.pro (reads hdf files) +; read_mod10a1_hdf.pro (reads MODIS files) +; get_lat_lon4tils.pro (perform conversion of original MODIS sinusoidal projection into lat/lon space) +; +; [sub]directories to be created prior executing this code: +; data/ - output directory (user needs to create) +; MODIS_lat_lon/ - holds previousely created lat/lon info (user needs to create this with get_lat_lon4tils.pro listed in dependencies) +; MOD10A1_data/ - holds MODIS input data (user has to bring it in; follow the dir structure) + +; There are five steps (runs) to process. Steps have to be processed in order. The current step must +; complete before the next is initiated. Use the 'goto' commands to control which step is exectued. +; When the current step is completed, uncomment the next-step goto command on lines 86-92 + +; To execture the code in terminal window type (without quotations): +; 'idl', then '.r get_snow_alb_mod10a1_30arcsec', then 'get_snow_alb_mod10a1_30arcsec' + +; Created April 2022 Biljana Orescanin SSIA@NASA + +; path to MODIS data (file name example: MOD10A1.A2022001.h24v06.061.2022003035827.hdf) + +path_in='./MOD10A1_data/' ; here is only one file to provide an example + +print, "You must make sure the 'path_in' is of the expected structure" + +; set parameters to loop over +if keyword_set(year) then begin + year=year[sort(year)] ; set an increasing order + years=strtrim(year,2) + print, ' Processing year(s): ', years +endif else begin + print,'No year to run specified on the input. Processing for default year - 2020!' + years =['2020'] +endelse + +snow_cvr_min = 0. ; minimum snow cover to consider [%] +cvr_cutoff = 0 ; snow cover cutoff in %s (to consider only tiles gt this value) +top_alb_limit= 99 ; the top %ile for snow albedo (I choose this value) to be considered (e.g. top 10% of the PDF) +top_limit = 10 ; the top %ile for snow cover (I choose this value) to be considered (e.g. top 10% of the PDF) +mis_val =-999. ; has to be in range [0,255] b/c snow_alb_til is byte array +snow_min_str=strtrim(snow_cvr_min,2) +year_start =years(0) +year_end =years(-1) +print, 'Start/End Years:',year_start,'/',year_end + +if keyword_set(h_s) and keyword_set(h_e) then begin + h_start=h_s + h_end =h_e +endif else begin + h_start=0 + h_end =35 +endelse +print, 'h_start:',h_start,' h_end:',h_end + +v_start=0 +v_end =17 + +dim_1d=2400l*2400l +dim_2d=[2400l,2400l] + +; ********* STEPS *********** +; [un]comment out the following goto's depending on what part of the code is to be executed +;goto, skip_extracting_snow_cvr ; *** STEP 2 +;goto, skip_calculating_snow_cvr ; *** STEP 3 +;goto, skip_reading_snow_alb ; *** STEP 4 +;goto, skip2ncoutput ; *** STEP 5 +; ********* STEPS *********** + +; loop over years +for iyear=0,n_elements(years)-1 do begin + + ; loop over horiontal tiles + for ih=h_start,h_end do begin + ih_str=strmid('0'+strtrim(ih,2),1,2,/reverse) + + ; loop over vertical tiles + for iv=v_start,v_end do begin + iv_str=strmid('0'+strtrim(iv,2),1,2,/reverse) + + ; get all files for the current h/v tile + filename=file_search(path_in+years(iyear)+ $ + '/n5eil01u.ecs.nsidc.org/DP4/MOST/MOD10A1.061/'+ $ + years(iyear)+'.'+'*.*/MOD10A1.A'+years(iyear)+ $ + '*.h'+ih_str+'v'+iv_str+'.*.hdf',count=nfiles) + + ; if no files available for this tile, skip to the next one (note: ~ 1/3 of tiles will be empty) + if nfiles eq 0 then begin + print, 'No data for tile: h'+ih_str+'v'+iv_str, ' skipping' + continue + endif + + ; declare arrays to hold all days info + snow_cvr_pdf=make_array(dim_1d,101,/long,value=0l) ; to hold pdf of snow cover values + + ; loop over files (i.e. days) for this tile to stitch + for ifile=0,nfiles-1 do begin + + ; read file + data=read_mod10a1_hdf(filename(ifile)) + + ; keep only what you need + ; See bottom of the code for details + snow_cvr_til=data.NDSI_Snow_Cover ; values [0,100] + snow_cvr_qc =data.NDSI_Snow_Cover_Basic_QA ; values [0,255] 0=best, 1=good, 2=ok, 3=poor-not used + + ; reform all arrays into 1D arrays so I can apply indexes from where command + snow_cvr_til=reform(snow_cvr_til,dim_2d[0]*dim_2d[1],/overwrite) + snow_cvr_qc =reform(snow_cvr_qc ,dim_2d[0]*dim_2d[1],/overwrite) + + ; If data present then accumulate non-missing values and their counts + ind_val=where(snow_cvr_til gt snow_cvr_min and snow_cvr_til le 100. and $ + snow_cvr_qc eq 0,c_val) + + ; If no valida data of albedo and snow cover in this tile, skip. + if c_val eq 0 then begin + continue + endif + + ; Get PDFs of snow fraction and albedo + for ival=0,c_val-1 do begin + snow_cvr_pdf(ind_val(ival),fix(snow_cvr_til[ind_val(ival)]))++ + endfor + + endfor ; ifile + + openw, lun, 'data/data_out/snow_cov_pdfs_titch08_OD10A1.A.'+years(iyear)+ $ + '.h'+ih_str+'v'+iv_str+'.bin.gz', /get_lun,/compress + writeu,lun, snow_cvr_pdf + free_lun,lun + + endfor ; iv + endfor ; ih +endfor ; iyear + +print, 'Done creating PDFs of snow cover and albedo' +stop + +skip_extracting_snow_cvr: +print, 'Starting snow fraction top percentile calculations' + + ; -- get snow fractions for the top n-percentile of PDFs at each pixel + ; This will take a while since it has to be done pixel by pixel + + ; Few notes: + ; - Needed is a mean albedo corresponding to the top 10% (by count) snow fraction values + ; but only among those vaues that correspond to 60% or more of snow over a grid box. + ; - So, used is a snow cover cutoff value of 60 to get the top 90the percentile of snow cover values + +; loop over horiontal tiles +for ih=h_start,h_end do begin + ih_str=strmid('0'+strtrim(ih,2),1,2,/reverse) + + ; loop over vertical tiles + for iv=v_start,v_end do begin + iv_str=strmid('0'+strtrim(iv,2),1,2,/reverse) + + snow_cvr_pdf_tmp=make_array(dim_1d,101,/long,value=0l) ; to hold current pdf of snow cover values + snow_cvr_pdf_all=make_array(dim_1d,101,/long,value=0l) ; to hold cummulatinve pdfs of snow cover values + + ; First read PDFs of all the years for each tile. Then, find the top %ile and write out the cutoffs + + ; get all files for the current h/v tile (all available years) + filename_cvr=file_search('data/data_out/snow_cov_pdfs_titch08_OD10A1.A.*.h'+ih_str+'v'+iv_str+'.bin.gz',count=nfiles2) + + ; if no files available for this tile, skip to the next one (note: ~ 1/3 of tiles will be empty) + if nfiles2 eq 0 then begin + print, 'No data for tile: h'+ih_str+'v'+iv_str, ' skipping' + continue + endif + + for ifile=0,nfiles2-1 do begin + openr, lun, filename_cvr(ifile), /get_lun,/compress + readu, lun, snow_cvr_pdf_tmp + free_lun,lun + + snow_cvr_pdf_all=snow_cvr_pdf_all+snow_cvr_pdf_tmp + endfor + + ; find the snow cover cutoff + sf_lim_tail_mean=make_array(dim_1d,/float,value=mis_val) ; array to store the top 90th snow fraction %ile cutoff for each pixel + + for ipix=0,dim_1d-1 do begin + + tot_pix=total(snow_cvr_pdf_all(ipix,*)) ; tot # of valid snow fraction obs at this pixel + + if tot_pix lt 10 then continue ; if lt 10 valid elements leave as missing (no enough data) + + tot_sf_pix=0l + for ibin=100,30,-1 do begin ; accumulate from the top bin down till you get enough data. + ; Yet, don't go below 30th bin (i.e. snow fraction lt 30%) + ; b/c there is not enough snow to make it a "reliable albedo estimate" + tot_sf_pix=tot_sf_pix+snow_cvr_pdf_all(ipix,ibin)*ibin + if total(snow_cvr_pdf_all(ipix,ibin:100))/tot_pix*100. gt top_limit then begin + sf_lim_tail_mean(ipix)=tot_sf_pix/total(snow_cvr_pdf_all(ipix,ibin:100)) + break ; ibin loop + endif + endfor ; ibin + + endfor ; ipix + + ; write out the snow cover cutoff %ile for this MODIS tile + openw, lun, 'data/data_out/snow_cov_cutoff_titch08_MOD10A1.A.h'+ih_str+'v'+iv_str+'_'+year_start+'_'+year_end+'.bin.gz', /get_lun,/compress + writeu,lun, sf_lim_tail_mean ;,sf_max ; both are [dim_1d] float arrays + free_lun,lun + + endfor ; iv +endfor ;ih + +print, 'Done snow fraction top percentile calculations' +stop + +skip_calculating_snow_cvr: +print, 'Starting reading in the albedo data to get mean value for those grids that have above the limit snow cover' + +; loop over years +for iyear=0,n_elements(years)-1 do begin + + ; loop over horiontal tiles + for ih=h_start,h_end do begin + ih_str=strmid('0'+strtrim(ih,2),1,2,/reverse) + + ; loop over vertical tiles + for iv=v_start,v_end do begin + iv_str=strmid('0'+strtrim(iv,2),1,2,/reverse) + + ; get all files for the current h/v tile + filename=file_search(path_in+years(iyear)+'/n5eil01u.ecs.nsidc.org/DP4/MOST/MOD10A1.061/'+years(iyear)+'.'+ $ + '*.*/MOD10A1.A'+years(iyear)+'*.h'+ih_str+'v'+iv_str+'.*.hdf',count=nfiles3) + + ; if no files available for this tile, skip to the next one (note: ~ 1/3 of tiles will be empty) + if nfiles3 eq 0 then begin + print, 'No data for tile: h'+ih_str+'v'+iv_str, ' skipping' + continue + endif + + ; read in the snow cover cutoff %ile for this MODIS tile + sf_lim_tail_mean=make_array(dim_1d,/float,value=mis_val) ; to store the top snow fraction %ile cutoff for each pixel + openr, lun, 'data/data_out/snow_cov_cutoff_titch08_MOD10A1.A.h'+ih_str+'v'+iv_str+'_'+year_start+'_'+year_end+'.bin.gz', /get_lun,/compress + readu,lun, sf_lim_tail_mean + free_lun,lun + + ; declare arrays to hold all days info + accu_alb=make_array(dim_1d,/float,value=0l) ; to hold accumulated snow albedo values + accu_cnt=make_array(dim_1d,/float,value=0l) ; to hold couhnts of accumulated values + + ; loop over files (i.e. days) for this tile to stitch + for ifile=0,nfiles3-1 do begin + + ; read file + data=read_mod10a1_hdf(filename(ifile)) + + ; keep only what you need ; see bottom of the code for details + snow_alb_til=data.SNOW_ALBEDO_DAILY_TILE ; values [0,100] + snow_cvr_til=data.NDSI_Snow_Cover ; values [0,100] + snow_cvr_qc =data.NDSI_Snow_Cover_Basic_QA ; values [0,255] 0=best, 1=good, 2=ok, 3=poor-not used + + ; reform all arrays into 1D arrays so I can apply indexes from where command + snow_alb_til=reform(snow_alb_til,dim_2d[0]*dim_2d[1],/overwrite) + snow_cvr_til=reform(snow_cvr_til,dim_2d[0]*dim_2d[1],/overwrite) + snow_cvr_qc =reform(snow_cvr_qc ,dim_2d[0]*dim_2d[1],/overwrite) + + ; if no valid data of abledo and snow cover in this tile, skip. + ; If data present then accumulate non-missing values and their counts + ind_val=where(snow_alb_til gt 0 and snow_alb_til le 100 and $ + snow_cvr_til gt 0 and snow_cvr_til le 100 and $ + sf_lim_tail_mean gt 0 and snow_cvr_qc eq 0,c_val) + + if c_val eq 0 then begin + continue + endif + + ; get accumulated albedo + for ipix=0,c_val-1 do begin + if snow_cvr_til(ind_val[ipix]) ge sf_lim_tail_mean(ind_val[ipix]) then begin + accu_alb(ind_val[ipix])=accu_alb(ind_val[ipix])+snow_alb_til(ind_val[ipix]) + accu_cnt(ind_val[ipix])=accu_cnt(ind_val[ipix])+1. + endif + endfor ; ipix + + endfor ; ifile + + ; write out the counts, cumulative and mean values of albedo and PDFs of albedo + ; for this tile (these will be stitched once all completed) + openw, lun, 'data/data_out/snow_alb_pdfs_08_MOD10A1.A.'+years(iyear)+ $ + '.h'+ih_str+'v'+iv_str+'_'+strtrim(100-top_limit,2)+'%ile_cover2_gt_'+ $ + strtrim(cvr_cutoff,2)+'.bin.gz', /get_lun,/compress + writeu,lun, accu_alb,accu_cnt + free_lun,lun + + endfor ; iv + endfor ;ih +endfor ; iyear +print, 'Done with calculating mean snow albedo' +stop + +skip_reading_snow_alb: + +; -- All snow albedo PDFs are in, only in yearly files. Read them all +; and make the cumulative stats for mean albedo at a chosen %ile +; This is to be done on a single CPU as a single sbatch job +print, 'Reading in all Snow Albedo accum and counts to form the overall mean albedo values' + +; need to read in all the years for each tile, find top %ile and write out the mean albedo +; loop over horizontal tiles +for ih=h_start,h_end do begin + ih_str=strmid('0'+strtrim(ih,2),1,2,/reverse) + + ; loop over vertical tiles + for iv=v_start,v_end do begin + iv_str=strmid('0'+strtrim(iv,2),1,2,/reverse) + + ; get all files for the current h/v tile (all available years) + filename_alb=file_search('data/data_out/snow_alb_pdfs_08_MOD10A1.A.*.h'+ $ + ih_str+'v'+iv_str+'_'+strtrim(100-top_limit,2) + $ + '%ile_cover2_gt_'+strtrim(cvr_cutoff,2)+'.bin.gz',count=nfiles4) + + ; if no files available for this tile, skip to the next one (note: ~ 1/3 of tiles will be empty) + if nfiles4 eq 0 then begin + print, 'No data for tile: h'+ih_str+'v'+iv_str, ' skipping' + continue + endif + + print, 'tile: h'+ih_str+'v'+iv_str + + ; declare arrays to hold all days info + accu_alb_tmp=make_array(dim_1d,/float,value=0l) ; to hold accumulated snow albedo values + accu_cnt_tmp=make_array(dim_1d,/float,value=0l) ; to hold counts of accumulated values + snow_alb_accu_all=0. + snow_alb_cnt_all =0. + + for ifile=0,nfiles4-1 do begin + openr, lun, filename_alb(ifile), /get_lun,/compress + readu, lun, accu_alb_tmp,accu_cnt_tmp + free_lun,lun + snow_alb_accu_all=snow_alb_accu_all+accu_alb_tmp + snow_alb_cnt_all =snow_alb_cnt_all +accu_cnt_tmp + endfor + + ; get mean albedo + mean_alb=snow_alb_accu_all/snow_alb_cnt_all + mean_alb[where(snow_alb_cnt_all lt 10,/null)]=mis_val + + ; write out the snow albedo max and cutoff %ile for this MODIS tile + openw, lun, 'data/data_out/snow_alb_08_'+strtrim(top_alb_limit,2)+'_cutoff_MOD10A1.A.h'+ $ + ih_str+'v'+iv_str+'_'+year_start+'_'+year_end+'.bin.gz', /get_lun,/compress + writeu,lun, mean_alb + free_lun,lun + + ; reset arrays for accumulating snow albedo + snow_alb_accu_all(*)=0l + snow_alb_cnt_all (*)=0l + + endfor ; iv +endfor ;ih + +print, 'Done with snow albedo cutoff %ile calculations' +stop + +skip2ncoutput: +; -- Now all the albedo vaules are in. Output them on +; GEOS-friendly 10x10 deg tiles using nc format + +; set new missing value +mis_val= 1.e15 + +print, 'Starting stitching' + +; array to store the top albedo %ile cutoff for each pixel at a given MODIS tile +alb_lim_tail_mean=make_array(dim_1d,/float,value=mis_val) + +; create 36x18 tiles at 30sec arc resolution (each tile is 10x10deg with 1200x1200 grid boxes) +; loop over horiontal tiles +for ih=h_start,h_end do begin + ih_str=strmid('0'+strtrim(ih+1,2),1,2,/reverse) + + ; loop over vertical tiles + for iv=v_start,v_end do begin + iv_str=strmid('0'+strtrim(iv+1,2),1,2,/reverse) + + ; declare array to store the output for this tile; fill with missing + alb_30sec_grid=make_array(1200l, 1200l, value=mis_val,/float) + + print, 'Creating tile: h'+ih_str+'v'+iv_str + + ; get min/max and all lat/lon values for this tile + minlat = iv *10.-90. + maxlat =(iv+1)*10.-90. + minlon = ih *10.-180.0 + maxlon =(ih+1)*10.-180.0 + lat_positions=minlat+indgen(1200)*10./1200. + lon_positions=minlon+indgen(1200)*10./1200. + + ; have to read +/- 1 MODIS tile in vertical direction + ; and as many as needed to cover all valid lat/lons in horizontal direction + + alb_lim_tail_mean_all=[] ; To store all 500m resolution albedo values + lat_all =[] ; corresponding to this tile to be used in + lon_all =[] ; gridding + + ; loop over vertical tiles + for iiv=17-iv-1,17-iv+1 do begin + iiv_str=strmid('0'+strtrim(iiv,2),1,2,/reverse) + + ; loop over horizontal tiles + for iih=0,35 do begin + iih_str=strmid('0'+strtrim(iih,2),1,2,/reverse) + + ; read in the cumulative and mean values for this tile (these will be stitched once all completed) + filename_alb=file_search('data/data_out/snow_alb_08_'+strtrim(top_alb_limit,2)+ $ + '_cutoff_MOD10A1.A.h'+iih_str+'v'+iiv_str+'_'+year_start+ $ + '_'+year_end+'.bin.gz',count=n_files5) + + if n_files5 ne 1 then continue + + openr, lun, filename_alb, /get_lun,/compress + readu,lun, alb_lim_tail_mean + free_lun,lun + + ; Reform the arrays back to 2 dimensions + alb_lim_tail_mean=reform(alb_lim_tail_mean,dim_2d,/overwrite) + + ; read lat and lon for this tile + lat2d = fltarr(2400l,2400l) + lon2d = fltarr(2400l,2400l) + file_lat_lon = 'MODIS_lat_lon/MODIS_hdres_lat_lon_v'+iiv_str+'_h'+iih_str+'.bin.gz' + openr , lun, file_lat_lon, /get_lun,/compress + readu , lun, lat2d,lon2d + free_lun, lun + + ; if no valid values for snow albedo on this tile, write all missing vals + ind_fit=where(lon2d ge minlon and lon2d le maxlon and $ + lat2d ge minlat and lat2d le maxlat and $ + alb_lim_tail_mean ge 0 and alb_lim_tail_mean le 100 , c_fit) + + ; if no grids with corresponding lat/lons to this tile, skip it + if c_fit eq 0 then continue + + ; if valid grids corresponding to this tile exist then remember them + alb_lim_tail_mean_all=[alb_lim_tail_mean_all,alb_lim_tail_mean[ind_fit]] + lon_all =[lon_all ,lon2d [ind_fit]] + lat_all =[lat_all ,lat2d [ind_fit]] + + endfor ; iih + endfor ; iiv + + ; if there are any valid values, grid them to populate the tile + if n_elements(alb_lim_tail_mean_all) gt 0 then begin + + print, 'Start gridding' + + ; regrid from 2400x2400 sinusoidal grid to 1200x1200 (30 arc sec) regular lat/lon grid (dateline-on-edge, pole-on-edge) + alb_30sec_grid=grid(alb_lim_tail_mean_all,lat_all,lon_all,nlat=1200,nlon=1200, $ + region=[minlat,maxlat,minlon,maxlon],mis_val=mis_val) + + ; scale to range [0.0,1.0] + ind_val=where(alb_30sec_grid ne mis_val,c_val) + if c_val gt 0 then alb_30sec_grid[ind_val]=alb_30sec_grid[ind_val]/100. + + endif + + ; write snow albedo in NetCDF format for the current MODIS tile + ; *** Create a NCDF file + + ; Set up the file & handler + nc_file='data/data_out/snow_alb_all_08_Top'+strtrim(top_alb_limit,2)+ $ + 'th_percentile_MOD10A1.A_30arcsec_'+year_start+'_'+year_end+ $ + '_H'+ih_str+'V'+iv_str+'.nc' + + ; create the file + fid=ncdf_create(nc_file,/CLOBBER,/NETCDF4_FORMAT) ; erese existing file and make a new one + + ; write global attributes + NCDF_ATTPUT, fid, 'N_lon_global' , '43200' , /GLOBAL,/char ; Total number of grids in i-direction + NCDF_ATTPUT, fid, 'N_lat_global' , '21600' , /GLOBAL,/char ; Total number of grids in j-direction + NCDF_ATTPUT, fid, 'i_ind_offset_LL', strtrim(ih*1200l+1,2), /GLOBAL,/char ; GEOS-friendly H grid box + NCDF_ATTPUT, fid, 'j_ind_offset_LL', strtrim(iv*1200l+1,2), /GLOBAL,/char ; GEOS-friendly V grid box + NCDF_ATTPUT, fid, 'CellSize=' , '30arcsec' , /GLOBAL,/char ; grid size + NCDF_ATTPUT, fid, 'CreatedBy' , 'borescan' , /GLOBAL,/char ; user info + spawn,'date',date1 ; get the time form the system + NCDF_ATTPUT, fid, 'Date' , strtrim(date1,2) , /GLOBAL,/char ; time and date + NCDF_ATTPUT, fid, 'Data_Resolution',' 1200 x 1200 ' , /GLOBAL,/char ; resolution of the run + NCDF_ATTPUT, fid, 'Region:' ,'MODIS tile H'+ih_str+'V'+iv_str, /GLOBAL,/char ; covearge + + ;Set Dimensions (there will be two dimentsions: lat and lon, i.e. x and y) + d=indgen(2,/LONG) ; number of dimensions that will be created + d[0]=ncdf_dimdef(fid,'N_lon',1200l) ; number of longitudes + d[1]=ncdf_dimdef(fid,'N_lat',1200l) ; number of latitudes + + ; Define variables to be stored + var_id1=ncdf_vardef(fid,'lon' ,d[0],/FLOAT) + var_id2=ncdf_vardef(fid,'lat' ,d[1],/FLOAT) + var_id3=ncdf_vardef(fid,'Snow_Albedo',d ,/FLOAT) + + ; Change modes (to enter data section/group) + ncdf_control,fid,/ENDEF + + ; Write the data + ncdf_varput,fid,'lat', lat_positions + ncdf_varput,fid,'lon', lon_positions + + ; missing value for MAPL is 1.e+15f + ncdf_varput,fid,'Snow_Albedo', alb_30sec_grid + NCDF_ATTPUT,fid,'Snow_Albedo', "scale_factor", 1.0 + NCDF_ATTPUT,fid,'Snow_Albedo', "offset", 0.0 + NCDF_ATTPUT,fid,'Snow_Albedo', "missing_value", 1.e15 + NCDF_ATTPUT,fid,'Snow_Albedo', "long_name", string("Snow Albedo"),/char + NCDF_ATTPUT,fid,'Snow_Albedo', "units", "-",/char + + ; Close the file & release the handler + ncdf_close,fid + + print, 'Done creating NCDF file' + + endfor ; iv +endfor ;ih + +; values in the SNOW_ALBEDO_DAILY_TILE are as following: + ; 1-100: snow albedo + ; 101: no decision + ; 111: night + ; 125: land + ; 137: inland water + ; 139: ocean + ; 150: cloud + ; 151: cloud detected as snow 250: missing + ; 251: self-shadowing + ; 252: land mask mismatch 253: BRDF failure + ; 254: non-production mask + +; NDSI snow cover general quality value ; values in the SNOW_ALBEDO_DAILY_TILE are as following: + ; 0=best, ; 1–100: snow albedo + ; 1=good, ; 101: no decision + ; 2=ok, ; 111: night + ; 3=poor-not used, ; 125: land + ; 4=other-not used, ; 137: inland water + ; 211=night, ; 139: ocean + ; 239=ocean, ; 150: cloud + ; 255=unusable L1B data or no data ; 151: cloud detected as snow 250: missing + ; 251: self-shadowing + ; 252: land mask mismatch 253: BRDF failure + ; 254: non-production mask + +stop +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/grid.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/grid.pro new file mode 100755 index 000000000..4b34d807d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/grid.pro @@ -0,0 +1,80 @@ +function grid,data,lat,lon,region=rgn,nlat=nlat,nlon=nlon, $ + npts=npts,mis_val=mval + +; function to [re]grid data given lat and lon position of the elements. +; Output is a 2D array on a lat/lon grid, holding means of the elements that fell +; into each gridbox. Default regridded data resolution is 1deg (both lat/lon) + +; Optional arguments include: +; - number of points along lat-direction (nlat) and lon-direction (nlon) - controles the resolution of the output +; - a user-defined missing value (mval) - defines missing value +; - a user-defined region to [re]grid over. [min_lat,mat_lat, min_lon, max_lon] +; - flag '/npts'. Will add the number of elements per grid box to the output + +if (n_elements(rgn) EQ 0) then rgn=[-90.0,90.0,-180.0,180.0] +if (n_elements(nlat) EQ 0) then nlat=180 +if (n_elements(nlon) EQ 0) then nlon=360 +if (n_elements(mval) EQ 0) then mval=-999.0 +if (n_elements(eps) EQ 0) then eps=0.1 +if max(lon) gt 180. then lon[where(lon gt 180.,/null)]=lon[where(lon gt 180.,/null)]-360. +minlat = rgn[0] +maxlat = rgn[1] +minlon = rgn[2] +maxlon = rgn[3] +xinc=(maxlon-minlon)/float(NLON) +yinc=(maxlat-minlat)/float(NLAT) +ngrd=lonarr(NLON,NLAT) +rgrd=fltarr(NLON,NLAT) +sgrd=fltarr(NLON,NLAT) + +; Eliminate missing data + +lat2=lat +lon2=lon +data2=data +m=where(abs(data2-mval) GT eps AND abs(lat2-mval) GT eps AND abs(lon2-mval) GT eps,cnt) +if (cnt GT 0) then begin + lat2=lat[m] + lon2=lon[m] + data2=data[m] +endif + +; Determine if data is inside specified grid region + +xind=long((lon2 - minlon)/double(xinc)) +yind=long((lat2 - minlat)/double(yinc)) +m=where(xind GE 0 AND xind LT NLON AND yind GE 0 AND yind LT NLAT,cnt) + +lat2=lat2[m] +lon2=lon2[m] +data2=data2[m] +xind=xind[m] +yind=yind[m] + +ind=xind+NLON*yind +h=histogram(ind,MIN=0,MAX=long(NLON)*long(NLAT),locations=x) +m=where(h GT 0,mcnt) +for i=0L,mcnt-1 do begin + ind2=where(ind EQ x[m[i]],ncnt) + ngrd[m[i]] = ngrd[m[i]] + ncnt + rgrd[m[i]] = rgrd[m[i]] + total(data2[ind2]) +endfor + +; Compute grid averages + +ind=where(ngrd EQ 0,cnt) +if (cnt GT 0) then rgrd[ind] = mval +ind=where(ngrd GT 0,cnt) +if (cnt GT 0) then rgrd[ind] = rgrd[ind] / float(ngrd[ind]) + +n=1 +if (keyword_set(npts)) then n=n+1 +a=fltarr(NLON,NLAT,n) +a[*,*,0] = rgrd +n=1 +if (keyword_set(npts)) then begin + a[*,*,n] = float(ngrd) + n = n + 1 +endif +return,a +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/read_hdf_sd.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/read_hdf_sd.pro new file mode 100755 index 000000000..401a4cd8b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/read_hdf_sd.pro @@ -0,0 +1,90 @@ +function read_hdf_sd,filename,vars=varname,list=list + +FileID=HDF_SD_START(filename,/READ) +HDF_SD_FILEINFO,FileID,nvar,nattr + +nvarname = n_elements(varname) +if (nvarname EQ 0) then varname='' +a=create_struct('FileName',filename) + +var=strarr(nvar) +typ=strarr(nvar) +ndim=intarr(nvar) +dim=strarr(nvar,10) +varlen = 0 +typlen = 0 +dimnum = 0 +ndmax = 0 +index = 0 +ivar = 0 +while (index LT nvar) do begin + sds_id=HDF_SD_SELECT(FileID,index) + HDF_SD_GETINFO, sds_id, NAME=name, DIMS=dims, NDIMS=ndims, TYPE=type + ind = where(name EQ varname, cnt) + if (cnt GT 0 OR nvarname EQ 0) then begin + if (ndims GT 1 OR dims[0] GT 0) then begin + var[ivar] = name + typ[ivar] = type + ndim[ivar] = ndims + nd=0 + flag=0 + for i=0,ndims-1 do begin + dim[ivar,i] = dims[i] + nd=nd+alog10(dim[ivar,i])+3 + if (dims[i] EQ 0) then flag=1 + endfor + if (flag EQ 0) then begin + if (nd GT ndmax) then ndmax=nd + if (strlen(var[ivar]) GT varlen) then varlen=strlen(var[ivar]) + if (strlen(typ[ivar]) GT typlen) then typlen=strlen(typ[ivar]) + if (ndims GT dimnum) then dimnum=ndims + HDF_SD_GETDATA, sds_id, data + name = var[ivar] + c=['-','.','/','(',')','+'] + for n=0,n_elements(c)-1 do begin + pos=strpos(name,c[n]) + while (pos GE 0) do begin + strput,name,' ',pos + pos=strpos(name,c[n]) + endwhile + endfor + name = strcompress(name,/remove_all) + fchar=strmid(name,0,1) + if (fchar GE '0' AND fchar LE '9') then name='Var_'+name + + svar=string(var[ivar],ivar,format='(a,"_",i3.3)') + a = create_struct(a, name, data) + ivar = ivar + 1 + endif + endif + endif + index = index + 1 +endwhile +nvar = ivar + +if (nvar GT 0) then begin + s1=string(fix(alog10(nvar))+1,format='("i",i1)') + s2='2x,a' + s3=string(typlen+1,format='("a",i2.2)') + ndmax=0 + if (keyword_set(list)) then openw,2,'var.list' + for index=0,nvar-1 do begin + fmt='("SD[",'+s1+',"]: ",'+s3+','+s2 + s4=strarr(ndim[index]) + for i=0,ndim[index]-1 do begin + s4[i] = string(alog10(dim[index,i])+1,format='("i",i1)') + fmt=fmt+',"[",'+s4[i]+',"]"' + endfor + fmt=fmt+')' + if (keyword_set(list)) then $ + printf,2,index,typ[index],var[index],dim[index,0:ndim[index]-1],format=fmt + endfor +endif else begin + a = -1 +endelse + +if (keyword_set(list)) then close,2 +HDF_SD_END, FileID +return,a +end + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/read_mod10a1_hdf.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/read_mod10a1_hdf.pro new file mode 100755 index 000000000..5e30667c8 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/albedo/snow/read_mod10a1_hdf.pro @@ -0,0 +1,30 @@ +function read_mod10a1_hdf, filename + +; code to read MODIS snow albedo files, like: +; MOD10A1.A2020365.h34v08.061.2021006142942.hdf +; or +; MOD10A1.A2022002.h12v11.006.2022004045329.hdf + +; to be used in the stitching process + +; Created March 2022 Biljana Orescanin NASA@SSAI + +vars2read= [ $ + 'NDSI_Snow_Cover' , $ + 'NDSI_Snow_Cover_Basic_QA' , $ + 'NDSI_Snow_Cover_Algorithm_Flags_QA', $ + 'NDSI' , $ + 'Snow_Albedo_Daily_Tile' , $ + 'orbit_pnt' , $ + 'granule_pnt' $ + ] + +; read the hdf file; no scale and offsets, so it's ok to use read_hdf_sd +; note: read_hdf_sd does not allow for choosing which variables to read, +; so I read them all +d=read_hdf_sd(filename) + +return, d + +stop +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/CMakeLists.txt new file mode 100644 index 000000000..72c5bf489 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/CMakeLists.txt @@ -0,0 +1,7 @@ +# build without installation + +add_library(m_loss_during_routines m_loss_during_routines.f90) +add_executable(loss_during_day.x loss_during_day.f90) +target_link_libraries(loss_during_day.x m_loss_during_routines) +add_executable(loss_surf_5cm_gensoil.x loss_surf_5cm_gensoil.f90) +target_link_libraries(loss_surf_5cm_gensoil.x m_loss_during_routines) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/PEATCLSM_fitting_CLSM_params.R b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/PEATCLSM_fitting_CLSM_params.R similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/PEATCLSM_fitting_CLSM_params.R rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/PEATCLSM_fitting_CLSM_params.R diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_during_day.f90 similarity index 97% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_during_day.f90 index 904693112..d628ef2eb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_during_day.f90 @@ -33,6 +33,7 @@ PROGRAM loss_during_day character*300 :: soilfile logical :: file_exists,mult_jobs real, dimension (81,12) :: rzw, sfexc,tscale + character*400 :: MAKE_BCS_INPUT_DIR ! --------- VARIABLES FOR *OPENMP* PARALLEL ENVIRONMENT ------------ ! @@ -92,6 +93,8 @@ PROGRAM loss_during_day job=1 I = command_argument_count() + MAKE_BCS_INPUT_DIR = "/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/" + if(I < 1 ) then print *, "Job Segment is not specified: ", i print *, trim(Usage) @@ -143,8 +146,7 @@ PROGRAM loss_during_day endif end if - soilfile='/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/' & - //'/Woesten_SoilParam/Soil_param_100_mineral_3_OC_026_046_112_Woesten_topsoil.txt' + soilfile= trim(MAKE_BCS_INPUT_DIR)//'/land/soil/soil_water_loss/v2/Soil_param_100_mineral_3_OC_026_046_112_Woesten_topsoil.txt' open (10, file=trim(soilfile),form='formatted',status='old', & action='read') @@ -159,8 +161,7 @@ PROGRAM loss_during_day close (10,status='keep') - path = '/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/' & - //'/Woesten_SoilParam/loss_pd_top/' + path = trim(MAKE_BCS_INPUT_DIR)//'/land/soil/soil_water_loss/v2/loss_pd_top/' !$OMP PARALLELDO DEFAULT(NONE) & !$OMP SHARED(A_BEE, A_PSIS,A_AKSAT,A_POROS,n_threads, low_ind, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_perday.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_perday.sh similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_perday.sh rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_perday.sh diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_perhour.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_perhour.sh similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_perhour.sh rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_perhour.sh diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_surf_5cm_gensoil.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_surf_5cm_gensoil.f90 similarity index 95% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_surf_5cm_gensoil.f90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_surf_5cm_gensoil.f90 index 879bd27f8..514c2622a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_surf_5cm_gensoil.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/loss_surf_5cm_gensoil.f90 @@ -27,6 +27,7 @@ PROGRAM loss_surf_5cm_gensoil logical :: skip = .false. logical :: layer_2cm = .false. + character*400 :: MAKE_BCS_INPUT_DIR ! --------- VARIABLES FOR *OPENMP* PARALLEL ENVIRONMENT ------------ ! ! NOTE: "!$" is for conditional compilation @@ -98,8 +99,8 @@ PROGRAM loss_surf_5cm_gensoil end do end if - soilfile='/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/' & - //'/Woesten_SoilParam/Soil_param_100_mineral_3_OC_026_046_112_Woesten_topsoil.txt' + MAKE_BCS_INPUT_DIR = '/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/' + soilfile= trim(MAKE_BCS_INPUT_DIR)//'/land/soil/soil_water_loss/v2/Soil_param_100_mineral_3_OC_026_046_112_Woesten_topsoil.txt' open (10, file=trim(soilfile),form='formatted',status='old', & action='read') @@ -113,8 +114,7 @@ PROGRAM loss_surf_5cm_gensoil close (10,status='keep') - path = '/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/' & - //'//Woesten_SoilParam/loss_ph/' + path = trim(MAKE_BCS_INPUT_DIR)//'/land/soil/soil_water_loss/v2/loss_ph/' if(.not.skip) then !$OMP PARALLELDO DEFAULT(NONE) & @@ -386,10 +386,8 @@ PROGRAM loss_surf_5cm_gensoil !$OMP ENDPARALLELDO if(layer_2cm) STOP endif - opath = '/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/' & - //'//SoilClasses-SoilHyd-TauParam.dat' - soilfile='/discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/' & - //'/Woesten_SoilParam/Soil_param_100_mineral_3_OC_026_046_112_Woesten_topsoil.txt' + opath = trim(MAKE_BCS_INPUT_DIR) //'/land/soil/SOIL-DATA/SoilClasses-SoilHyd-TauParam.dat' + soilfile= trim(MAKE_BCS_INPUT_DIR) //'/land/soil/soil_water_loss/v2/Soil_param_100_mineral_3_OC_026_046_112_Woesten_topsoil.txt' open (20, file=trim(soilfile),form='formatted',status='old', & action='read') diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/m_loss_during_routines.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/m_loss_during_routines.f90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/m_loss_during_routines.f90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/m_loss_during_routines.f90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt index 320bc3430..d073187a8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt @@ -22,14 +22,14 @@ set (exe_srcs esma_add_library (${this} SRCS ${srcs} - DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran) + DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran GEOS_CatchCNShared) foreach (src ${exe_srcs}) string (REGEX REPLACE ".F90" ".x" exe ${src}) ecbuild_add_executable ( TARGET ${exe} SOURCES ${src} - LIBS MAPL GFTL_SHARED::gftl-shared GEOS_SurfaceShared GEOSroute_GridComp GEOS_LandShared ${this}) + LIBS MAPL GFTL_SHARED::gftl-shared GEOS_SurfaceShared GEOSroute_GridComp GEOS_LandShared GEOS_CatchCNShared ${this}) endforeach () install(PROGRAMS mk_Restarts DESTINATION bin) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index d28137c71..905127189 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -4,24 +4,16 @@ module CatchmentCNRstMod use mk_restarts_getidsMod, ONLY: & GetIds use mpi + use ESMF use MAPL use CatchmentRstMod, only : CatchmentRst + use clm_varpar_shared , only : nzone => NUM_ZON_CN, nveg => NUM_VEG_CN, & + VAR_COL_40, VAR_PFT_40, VAR_COL_45, VAR_PFT_45, & + npft => numpft_CN + use nanMod , only : nan + implicit none - real, parameter :: ECCENTRICITY = 0.0167 - real, parameter :: PERIHELION = 102.0 - real, parameter :: OBLIQUITY = 23.45 - integer, parameter :: EQUINOX = 80 - - integer, parameter :: nveg = 4 - integer, parameter :: nzone = 3 - integer, parameter :: VAR_COL_CLM40 = 40 ! number of CN column restart variables - integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column - integer, parameter :: npft = 19 - integer, parameter :: npft_clm45 = 19 - integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables - integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column - real, parameter :: nan = O'17760000000' real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) @@ -115,14 +107,14 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) catch%meta = meta catch%time = time if (index(cnclm, '40') /=0) then - catch%VAR_COL = VAR_COL_CLM40 - catch%VAR_PFT = VAR_PFT_CLM40 catch%isCLM40 = .true. + catch%VAR_COL = VAR_COL_40 + catch%VAR_PFT = VAR_PFT_40 endif if (index(cnclm, '45') /=0) then - catch%VAR_COL = VAR_COL_CLM45 - catch%VAR_PFT = VAR_PFT_CLM45 catch%isCLM45 = .true. + catch%VAR_COL = VAR_COL_45 + catch%VAR_PFT = VAR_PFT_45 endif if (myid == 0) then @@ -206,14 +198,14 @@ function CatchmentCNRst_empty(meta, cnclm, time, rc) result (catch) catch%time = time catch%meta = meta if (index(cnclm, '40') /=0) then - catch%VAR_COL = VAR_COL_CLM40 - catch%VAR_PFT = VAR_PFT_CLM40 catch%isCLM40 = .true. + catch%VAR_COL = VAR_COL_40 + catch%VAR_PFT = VAR_PFT_40 endif if (index(cnclm, '45') /=0) then - catch%VAR_COL = VAR_COL_CLM45 - catch%VAR_PFT = VAR_PFT_CLM45 catch%isCLM45 = .true. + catch%VAR_COL = VAR_COL_45 + catch%VAR_PFT = VAR_PFT_45 endif call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) @@ -556,12 +548,20 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) integer, allocatable, dimension (:) :: tid_offl, id_loc real, allocatable, dimension (:) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2 - integer :: AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR=0,AGCM_DATE + integer :: AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR=0,AGCM_DATE, & + AGCM_MI, AGCM_S, dofyr real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl, tg_tmp real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:), var_out(:), var_psn(:,:,:) integer :: status, in_ntiles, out_ntiles, numprocs logical :: root_proc integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft + real, allocatable, dimension(:) :: lat_tmp + type(MAPL_SunOrbit) :: ORBIT + type(ESMF_Time) :: CURRENT_TIME + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Clock) :: CLOCK + type(ESMF_Config) :: CF + character(*), parameter :: Iam = "CatchmentCN::Re_tile" @@ -606,6 +606,8 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) allocate (tid_offl(in_ntiles)) allocate (id_loc_cn (nt_local (myid + 1),nveg)) + allocate (lat_tmp(in_ntiles)) + do n = 1, in_ntiles tid_offl(n) = n enddo @@ -618,10 +620,43 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) AGCM_YY = AGCM_DATE / 10000 AGCM_MM = (AGCM_DATE - AGCM_YY*10000) / 100 AGCM_DD = (AGCM_DATE - AGCM_YY*10000 - AGCM_MM*100) + AGCM_MI = 0 + AGCM_S = 0 + + + !1) Set current date & time + ! ----------------------- + + call ESMF_CalendarSetDefault ( ESMF_CALKIND_GREGORIAN, rc=status ) + + call ESMF_TimeSet ( CURRENT_TIME, YY = AGCM_YY, & + MM = AGCM_MM, & + DD = AGCM_DD, & + H = AGCM_HR, & + M = AGCM_MI, & + S = AGCM_S , & + rc=status ) + VERIFY_(STATUS) - call compute_dayx ( & - out_NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - this%LATG, DAYX) + !2) create a clock + ! time interval value is not critical here, just for a clock + + call ESMF_TimeIntervalSet(TimeStep, S=450, RC=status) + clock = ESMF_ClockCreate(TimeStep, startTime = CURRENT_TIME, RC=status) + VERIFY_(STATUS) + call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) + + !3) create an orbit + CF = ESMF_ConfigCreate(RC=STATUS) + VERIFY_(status) + + ORBIT = MAPL_SunOrbitCreateFromConfig(CF, CLOCK, .false., RC=status) + VERIFY_(status) + + !4) current daylight duration + lat_tmp = this%latg*MAPL_PI/180. + call MAPL_SunGetDaylightDuration(ORBIT, lat_tmp, dayx, currTime=CURRENT_TIME,RC=STATUS) + VERIFY_(STATUS) ! save the old vaues dimension (in_ntiles, nv) ityp_offl = this%cnity @@ -709,6 +744,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) allocate (id_loc (out_ntiles)) deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2) deallocate (CLMC_pt1, CLMC_pt2, CLMC_st1, CLMC_st2) + deallocate (lat_tmp) do nv = 1, nveg call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -1270,157 +1306,6 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & end subroutine regrid_carbon - subroutine compute_dayx ( & - NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - LATT, DAYX) - - implicit none - - integer, intent (in) :: NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR - real, dimension (NTILES), intent (in) :: LATT - real, dimension (NTILES), intent (out) :: DAYX - integer, parameter :: DT = 900 - integer, parameter :: ncycle = 1461 ! number of days in a 4-year leap cycle (365*4 + 1) - real, dimension(ncycle) :: zc, zs - integer :: dofyr, sec,YEARS_PER_CYCLE, DAYS_PER_CYCLE, year, iday, idayp1, nn, n - real :: fac, YEARLEN, zsin, zcos, declin - - dofyr = AGCM_DD - if(AGCM_MM > 1) dofyr = dofyr + 31 - if(AGCM_MM > 2) then - dofyr = dofyr + 28 - if(mod(AGCM_YY,4) == 0) dofyr = dofyr + 1 - endif - if(AGCM_MM > 3) dofyr = dofyr + 31 - if(AGCM_MM > 4) dofyr = dofyr + 30 - if(AGCM_MM > 5) dofyr = dofyr + 31 - if(AGCM_MM > 6) dofyr = dofyr + 30 - if(AGCM_MM > 7) dofyr = dofyr + 31 - if(AGCM_MM > 8) dofyr = dofyr + 31 - if(AGCM_MM > 9) dofyr = dofyr + 30 - if(AGCM_MM > 10) dofyr = dofyr + 31 - if(AGCM_MM > 11) dofyr = dofyr + 30 - - sec = AGCM_HR * 3600 - DT ! subtract DT to get time of previous physics step - fac = real(sec) / 86400. - - - call orbit_create(zs,zc,ncycle) ! GEOS5 leap cycle routine - - YEARLEN = 365.25 - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - ! declination & daylength - ! ----------------------- - - YEAR = mod(AGCM_YY-1,YEARS_PER_CYCLE) - - IDAY = YEAR*int(YEARLEN)+dofyr - IDAYP1 = mod(IDAY,DAYS_PER_CYCLE) + 1 - - ZSin = ZS(IDAYP1)*FAC + ZS(IDAY)*(1.-FAC) ! sine of solar declination - ZCos = ZC(IDAYP1)*FAC + ZC(IDAY)*(1.-FAC) ! cosine of solar declination - - nn = 0 - do n = 1,days_per_cycle - nn = nn + 1 - if(nn > 365) nn = nn - 365 - ! print *, 'cycle:',n,nn,asin(ZS(n)) - end do - declin = asin(ZSin) - - ! compute daylength on input tile space (accounts for any change in physics time step) - ! do n = 1,ntiles_cn - ! fac = -(sin((latc(n)/zoom)*(MAPL_PI/180.))*zsin)/(cos((latc(n)/zoom)*(MAPL_PI/180.))*zcos) - ! fac = min(1.,max(-1.,fac)) - ! dayl(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - ! end do - - ! compute daylength on output tile space (accounts for lat shift due to split & change in time step) - - do n = 1,ntiles - fac = -(sin(latt(n)*(MAPL_PI/180.))*zsin)/(cos(latt(n)*(MAPL_PI/180.))*zcos) - fac = min(1.,max(-1.,fac)) - dayx(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - end do - - ! print *,'DAYX : ', minval(dayx),maxval(dayx), minval(latt), maxval(latt), zsin, zcos, dofyr, iday, idayp1, declin - - end subroutine compute_dayx - - ! ***************************************************************************** - - subroutine orbit_create(zs,zc,ncycle) - implicit none - - integer, intent(in) :: ncycle - real, intent(out), dimension(ncycle) :: zs, zc - - integer :: YEARS_PER_CYCLE, DAYS_PER_CYCLE - integer :: K, KP !, KM - real*8 :: T1, T2, T3, T4, FUN, Y, SOB, OMG, PRH, TT - real*8 :: YEARLEN - - ! STATEMENT FUNCTION - - FUN(Y) = OMG*(1.0-ECCENTRICITY*cos(Y-PRH))**2 - - YEARLEN = 365.25 - - ! Factors involving the orbital parameters - !------------------------------------------ - - OMG = (2.0*MAPL_PI/YEARLEN) / (sqrt(1.-ECCENTRICITY**2)**3) - PRH = PERIHELION*(MAPL_PI/180.) - SOB = sin(OBLIQUITY*(MAPL_PI/180.)) - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - if(days_per_cycle /= ncycle) stop 'bad cycle' - - ! ZS: Sine of declination - ! ZC: Cosine of declination - - ! Begin integration at vernal equinox - - KP = EQUINOX - TT = 0.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - - ! Integrate orbit for entire leap cycle using Runge-Kutta - - do K=2,DAYS_PER_CYCLE - T1 = FUN(TT ) - T2 = FUN(TT+T1*0.5) - T3 = FUN(TT+T2*0.5) - T4 = FUN(TT+T3 ) - KP = mod(KP,DAYS_PER_CYCLE) + 1 - TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - end do - end subroutine orbit_create end subroutine re_tile diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index c51462468..ea44b4cb9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -195,9 +195,13 @@ program mk_CatchCNRestarts ! 1104-1115: PSNSHAM (n,nz*nv) use MAPL + use ESMF use gFTL_StringVector use ieee_arithmetic, only: isnan => ieee_is_nan use mk_restarts_getidsMod, only: GetIDs, ReadTileFile_RealLatLon + use clm_varpar_shared , only : nzone => NUM_ZON_CN, nveg => NUM_VEG_CN, & + VAR_COL => VAR_COL_40, VAR_PFT => VAR_PFT_40, & + npft => numpft_CN implicit none include 'mpif.h' @@ -208,20 +212,6 @@ program mk_CatchCNRestarts integer :: myid=0, numprocs=1, mpierr, mpistatus(MPI_STATUS_SIZE) logical :: root_proc=.true. - ! Carbon model specifics - ! ---------------------- - - real, parameter :: ECCENTRICITY = 0.0167 - real, parameter :: PERIHELION = 102.0 - real, parameter :: OBLIQUITY = 23.45 - integer, parameter :: EQUINOX = 80 - - integer, parameter :: nveg = 4 - integer, parameter :: nzone = 3 - integer, parameter :: VAR_COL = 40 ! number of CN column restart variables - integer, parameter :: VAR_PFT = 74 ! number of CN PFT variables per column - integer, parameter :: npft = 19 - real, parameter :: nan = O'17760000000' real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value integer, parameter :: OutUnit = 40, InUnit = 50 @@ -294,7 +284,7 @@ program mk_CatchCNRestarts ! availability. !----------------------------------------------------- - + call ESMF_Initialize(LogKindFlag=ESMF_LOGKIND_NONE) I = iargc() @@ -592,8 +582,8 @@ program mk_CatchCNRestarts ! call regrid_carbon_vars_omp (NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR, OutFileName, OutTileFile) endif - call MPI_BARRIER( MPI_COMM_WORLD, mpierr) +call ESMF_Finalize(endflag=ESMF_END_KEEPMPI) call MPI_FINALIZE(mpierr) contains @@ -1108,7 +1098,14 @@ SUBROUTINE regrid_carbon_vars ( & real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:) real, allocatable :: var_col_out (:,:,:), var_pft_out (:,:,:,:) integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) - + integer :: AGCM_YYY, AGCM_MMM, AGCM_DDD, AGCM_HRR, AGCM_MI, AGCM_S, dofyr + type(MAPL_SunOrbit) :: ORBIT + type(ESMF_Time) :: CURRENT_TIME + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Clock) :: CLOCK + type(ESMF_Config) :: CF + + allocate (tid_offl (ntiles_cn)) allocate (ityp_offl (ntiles_cn,nveg)) allocate (fveg_offl (ntiles_cn,nveg)) @@ -1159,12 +1156,46 @@ SUBROUTINE regrid_carbon_vars ( & call ReadTileFile_RealLatLon (OutTileFile, i, long, latg) - ! Compute DAYX - ! ------------ - - call compute_dayx ( & - NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - LATG, DAYX) + !----------------------- + ! COMPUTE DAYX + !----------------------- + + AGCM_YYY = AGCM_YY + AGCM_MMM = AGCM_MM + AGCM_DDD = AGCM_DD + AGCM_HRR = AGCM_HR + AGCM_MI = 0 + AGCM_S = 0 + + + call ESMF_CalendarSetDefault ( ESMF_CALKIND_GREGORIAN, rc=status ) + + ! get current date & time + ! ----------------------- + call ESMF_TimeSet ( CURRENT_TIME, YY = AGCM_YYY, & + MM = AGCM_MMM, & + DD = AGCM_DDD, & + H = AGCM_HRR, & + M = AGCM_MI, & + S = AGCM_S , & + rc=status ) + VERIFY_(STATUS) + + call ESMF_TimeIntervalSet(TimeStep, S=450, RC=status) + clock = ESMF_ClockCreate(TimeStep, startTime = CURRENT_TIME, RC=status) + VERIFY_(STATUS) + call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) + + CF = ESMF_ConfigCreate(RC=STATUS) + VERIFY_(status) + + ORBIT = MAPL_SunOrbitCreateFromConfig(CF, CLOCK, .false., RC=status) + VERIFY_(status) + + ! compute current daylight duration + !---------------------------------- + call MAPL_SunGetDaylightDuration(ORBIT,latg,dayx,currTime=CURRENT_TIME,RC=STATUS) + VERIFY_(STATUS) ! --------------------------------------------- ! Read exact lonc, latc from offline .til File @@ -1745,161 +1776,6 @@ SUBROUTINE regrid_carbon_vars ( & END SUBROUTINE regrid_carbon_vars - ! ***************************************************************************** - - subroutine compute_dayx ( & - NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - LATT, DAYX) - - implicit none - - integer, intent (in) :: NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR - real, dimension (NTILES), intent (in) :: LATT - real, dimension (NTILES), intent (out) :: DAYX - integer, parameter :: DT = 900 - integer, parameter :: ncycle = 1461 ! number of days in a 4-year leap cycle (365*4 + 1) - real, dimension(ncycle) :: zc, zs - integer :: dofyr, sec,YEARS_PER_CYCLE, DAYS_PER_CYCLE, year, iday, idayp1, nn - real :: fac, YEARLEN, zsin, zcos, declin - - dofyr = AGCM_DD - if(AGCM_MM > 1) dofyr = dofyr + 31 - if(AGCM_MM > 2) then - dofyr = dofyr + 28 - if(mod(AGCM_YY,4) == 0) dofyr = dofyr + 1 - endif - if(AGCM_MM > 3) dofyr = dofyr + 31 - if(AGCM_MM > 4) dofyr = dofyr + 30 - if(AGCM_MM > 5) dofyr = dofyr + 31 - if(AGCM_MM > 6) dofyr = dofyr + 30 - if(AGCM_MM > 7) dofyr = dofyr + 31 - if(AGCM_MM > 8) dofyr = dofyr + 31 - if(AGCM_MM > 9) dofyr = dofyr + 30 - if(AGCM_MM > 10) dofyr = dofyr + 31 - if(AGCM_MM > 11) dofyr = dofyr + 30 - - sec = AGCM_HR * 3600 - DT ! subtract DT to get time of previous physics step - fac = real(sec) / 86400. - - call orbit_create(zs,zc,ncycle) ! GEOS5 leap cycle routine - - YEARLEN = 365.25 - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - ! declination & daylength - ! ----------------------- - - YEAR = mod(AGCM_YY-1,YEARS_PER_CYCLE) - - IDAY = YEAR*int(YEARLEN)+dofyr - IDAYP1 = mod(IDAY,DAYS_PER_CYCLE) + 1 - - ZSin = ZS(IDAYP1)*FAC + ZS(IDAY)*(1.-FAC) ! sine of solar declination - ZCos = ZC(IDAYP1)*FAC + ZC(IDAY)*(1.-FAC) ! cosine of solar declination - - nn = 0 - do n = 1,days_per_cycle - nn = nn + 1 - if(nn > 365) nn = nn - 365 - ! print *, 'cycle:',n,nn,asin(ZS(n)) - end do - - declin = asin(ZSin) - - ! compute daylength on input tile space (accounts for any change in physics time step) - ! do n = 1,ntiles_cn - ! fac = -(sin((latc(n)/zoom)*(MAPL_PI/180.))*zsin)/(cos((latc(n)/zoom)*(MAPL_PI/180.))*zcos) - ! fac = min(1.,max(-1.,fac)) - ! dayl(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - ! end do - - ! compute daylength on output tile space (accounts for lat shift due to split & change in time step) - - do n = 1,ntiles - fac = -(sin(latt(n)*(MAPL_PI/180.))*zsin)/(cos(latt(n)*(MAPL_PI/180.))*zcos) - fac = min(1.,max(-1.,fac)) - dayx(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - end do - - ! print *,'DAYX : ', minval(dayx),maxval(dayx), minval(latt), maxval(latt), zsin, zcos, dofyr, iday, idayp1, declin - - end subroutine compute_dayx - - ! ***************************************************************************** - - subroutine orbit_create(zs,zc,ncycle) - - implicit none - - integer, intent(in) :: ncycle - real, intent(out), dimension(ncycle) :: zs, zc - - integer :: YEARS_PER_CYCLE, DAYS_PER_CYCLE - integer :: K, KP !, KM - real*8 :: T1, T2, T3, T4, FUN, Y, SOB, OMG, PRH, TT - real*8 :: YEARLEN - - ! STATEMENT FUNCTION - - FUN(Y) = OMG*(1.0-ECCENTRICITY*cos(Y-PRH))**2 - - YEARLEN = 365.25 - - ! Factors involving the orbital parameters - !------------------------------------------ - - OMG = (2.0*MAPL_PI/YEARLEN) / (sqrt(1.-ECCENTRICITY**2)**3) - PRH = PERIHELION*(MAPL_PI/180.) - SOB = sin(OBLIQUITY*(MAPL_PI/180.)) - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - if(days_per_cycle /= ncycle) stop 'bad cycle' - - ! ZS: Sine of declination - ! ZC: Cosine of declination - - ! Begin integration at vernal equinox - - KP = EQUINOX - TT = 0.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - - ! Integrate orbit for entire leap cycle using Runge-Kutta - - do K=2,DAYS_PER_CYCLE - T1 = FUN(TT ) - T2 = FUN(TT+T1*0.5) - T3 = FUN(TT+T2*0.5) - T4 = FUN(TT+T3 ) - KP = mod(KP,DAYS_PER_CYCLE) + 1 - TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - end do - - end subroutine orbit_create - ! ***************************************************************************** SUBROUTINE NCDF_reshape_getOput (NCFID,CID,col,pft, get_var) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 index 931f97ffa..2e202a45b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 @@ -5,6 +5,7 @@ PROGRAM mk_catchANDcnRestarts use mpi use MAPL + use ESMF use CatchmentRstMod use CatchmentCNRstMod @@ -22,6 +23,8 @@ PROGRAM mk_catchANDcnRestarts call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, mpierr ) + call ESMF_Initialize(LogKindFlag=ESMF_LOGKIND_NONE) + call process_cmd() if (index(model, 'catchcn') /=0 ) then @@ -38,6 +41,8 @@ PROGRAM mk_catchANDcnRestarts call catch%write_nc4(out_file, __RC__) endif + call ESMF_Finalize(endflag=ESMF_END_KEEPMPI) + call MPI_FINALIZE(mpierr) contains