From 6ea04ebce05292ed212fb0864f97439dec5146d0 Mon Sep 17 00:00:00 2001 From: Whyborn Date: Fri, 6 Sep 2024 16:10:48 +1000 Subject: [PATCH 1/4] Add indices for AGCD met data --- offline/cable_cru_TRENDY.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/offline/cable_cru_TRENDY.F90 b/offline/cable_cru_TRENDY.F90 index 366fa6a14..f75fc3fe2 100644 --- a/offline/cable_cru_TRENDY.F90 +++ b/offline/cable_cru_TRENDY.F90 @@ -72,8 +72,10 @@ MODULE CABLE_CRU ! Set some private parameters REAL, PRIVATE, PARAMETER :: SecDay = 86400. INTEGER, PRIVATE, PARAMETER :: rain = 1, lwdn = 2, swdn = 3, pres = 4, qair = 5,& - tmax = 6, tmin = 7, uwind = 8, vwind = 9, fdiff = 10,& - prevTmax = 11, nextTmin = 12 + tmax = 6, tmin = 7, wind = 8, uwind = 8, vwind = 9,& + vaporpres0900 = 10, vaporpres1500 = 11, fdiff = 12,& + prevTmax = 13, nextTmin = 14, prevvaporpres0900 = 15,& + prevvaporpres1500 = 16 INTEGER, PRIVATE, PARAMETER :: sp = kind(1.0) INTEGER, PRIVATE :: ErrStatus From ffddb328d6ec6fbbd11264b045f3ad0dcdc5e2ff Mon Sep 17 00:00:00 2001 From: Whyborn Date: Wed, 11 Sep 2024 14:05:29 +1000 Subject: [PATCH 2/4] First round of changes piping AGCD met data through CRU routines --- offline/cable_cru_TRENDY.F90 | 226 +++++++++++++++++++++++------------ offline/cable_input.F90 | 98 ++++++++------- 2 files changed, 204 insertions(+), 120 deletions(-) diff --git a/offline/cable_cru_TRENDY.F90 b/offline/cable_cru_TRENDY.F90 index f75fc3fe2..60b5fb4d7 100644 --- a/offline/cable_cru_TRENDY.F90 +++ b/offline/cable_cru_TRENDY.F90 @@ -28,6 +28,23 @@ MODULE CABLE_CRU IMPLICIT NONE +! Set some private parameters +! To start the work on generalising the Met and subdiurnalisation process, +! we give each possible variable an index to refer to in the subdiurnalisation +! routine. The namelist can accept files for every variable, with unsupplied +! filenames defaulting to empty strings. Since we're still passing every +! possible file name to the Dataset generator, we need a consistent string +! to stop the building process. +REAL, PRIVATE, PARAMETER :: SecDay = 86400. +INTEGER, PRIVATE, PARAMETER :: rain = 1, lwdn = 2, swdn = 3, pres = 4,& + qair = 5, tmax = 6, tmin = 7, uwind = 8,& + vwind = 9, wind = 10, vp0900 = 11, vp1500 = 12,& + fdiff = 13, prevTmax = 14, nextTmin = 15,& + nextvp0900 = 16, prevvp1500 = 17 +INTEGER, PRIVATE, PARAMETER :: sp = kind(1.0) +INTEGER, PRIVATE, PARAMETER :: nVariables = 13 +INTEGER, PRIVATE :: ErrStatus + TYPE CRU_MET_TYPE REAL, DIMENSION(:), ALLOCATABLE :: MetVals END TYPE CRU_MET_TYPE @@ -39,11 +56,11 @@ MODULE CABLE_CRU INTEGER :: cYear ! CABLE main year INTEGER :: CTStep ! Day of year I think? INTEGER :: DtSecs ! Size of the timestep in seconds - INTEGER :: MetRecyc ! Period of the met forcing recycling + INTEGER :: MetRecycPeriod ! Period of the met forcing recycling INTEGER :: RecycStartYear ! Year to start the met recycling INTEGER :: Ktau - INTEGER, DIMENSION(10) :: FileID, VarId ! File and variable IDs for + INTEGER, DIMENSION(nVariables) :: FileID, VarId ! File and variable IDs for INTEGER :: NDepFId, NDepVId ! reading netCDF REAL, DIMENSION(:), ALLOCATABLE :: avg_lwdn ! Average longwave down rad, @@ -56,29 +73,19 @@ MODULE CABLE_CRU LOGICAL :: ReadDiffFrac ! Read diff fraction or calculate it LOGICAL :: LeapYears - LOGICAL, DIMENSION(10) :: isRecycled + LOGICAL, DIMENSION(nVariables) :: isRecycled LOGICAL, DIMENSION(:,:), ALLOCATABLE :: LandMask ! The logical landmask CHARACTER(LEN=16) :: CO2Method ! Method for choosing atmospheric CO2 CHARACTER(LEN=16) :: NDepMethod ! Method for choosing N deposition - TYPE(CRU_MET_TYPE), DIMENSION(12) :: Met + TYPE(CRU_MET_TYPE), DIMENSION(nVariables) :: Met ! The spatio-temporal datasets we use to generate the forcing data. - TYPE(SPATIO_TEMPORAL_DATASET), DIMENSION(10) :: MetDatasets - TYPE(SPATIO_TEMPORAL_DATASET) :: NDepDataset + TYPE(SPATIO_TEMPORAL_DATASET), DIMENSION(nVariables) :: MetDatasets + TYPE(SPATIO_TEMPORAL_DATASET) :: NDepDataset END TYPE CRU_TYPE -! Set some private parameters -REAL, PRIVATE, PARAMETER :: SecDay = 86400. -INTEGER, PRIVATE, PARAMETER :: rain = 1, lwdn = 2, swdn = 3, pres = 4, qair = 5,& - tmax = 6, tmin = 7, wind = 8, uwind = 8, vwind = 9,& - vaporpres0900 = 10, vaporpres1500 = 11, fdiff = 12,& - prevTmax = 13, nextTmin = 14, prevvaporpres0900 = 15,& - prevvaporpres1500 = 16 -INTEGER, PRIVATE, PARAMETER :: sp = kind(1.0) -INTEGER, PRIVATE :: ErrStatus - CONTAINS SUBROUTINE CRU_INIT(CRU) @@ -97,10 +104,11 @@ SUBROUTINE CRU_INIT(CRU) TYPE(CRU_TYPE), INTENT(OUT) :: CRU ! We want one filename for each variable, stored in a predefined index. - CHARACTER(LEN=256), dimension(13) :: InputFiles + CHARACTER(LEN=256), DIMENSION(nVariables) :: InputFiles + CHARACTER(LEN=256) :: nDepFile, CO2File, LandmaskFile ! Landmask to spatially filter the data - INTEGER, DIMENSION(:,:), ALLOCATABLE :: LandMask + INTEGER, DIMENSION(:,:), ALLOCATABLE :: Landmask ! Iterator variable for the variables INTEGER :: VarIndx @@ -112,43 +120,42 @@ SUBROUTINE CRU_INIT(CRU) ! Start with the things we want from the namelist. The namelist must set ! the filenames to read from, the method of choosing atmospheric carbon and ! nitrogen deposition, and the timestep. - CALL read_MET_namelist_cbl(InputFiles, CRU) + CALL read_MET_namelist_cbl(InputFiles, nDepFile, CO2File, LandmaskFile, CRU) ! Read the landmask and allocate appropriate memory for the array variables - CALL read_landmask(InputFiles(13), CRU) + CALL read_landmask(LandmaskFile, CRU) ! Build the spatio-temporal datasets for each necessary datatype - BuildKeys: DO VarIndx = 1, CRU%nMet - CALL prepare_spatiotemporal_dataset(InputFiles(VarIndx),& - CRU%MetDatasets(VarIndx)) + BuildKeys: DO VarIndx = 1, nVariables + ! Check whether the file has been defined in the namelist + IF (TRIM(InputFiles(VarIndx)) /= "None") THEN + CALL prepare_spatiotemporal_dataset(InputFiles(VarIndx),& + CRU%MetDatasets(VarIndx)) + END IF END DO BuildKeys ! Set the possible variable names for the main Met variables CALL read_variable_names(CRU%MetDatasets) - ! Open the datasets at the first file so we don't need CALL1 behaviour later - InitialiseDatasets: DO VarIndx = 1, CRU%nMet - CALL open_at_first_file(CRU%MetDatasets(VarIndx)) - END DO InitialiseDatasets - ! Set up the carbon reader - CALL prepare_temporal_dataset(InputFiles(11), CRU%CO2Vals) + CALL prepare_temporal_dataset(CO2File, CRU%CO2Vals) - ! Set up the nitrogen deposition reader - CALL prepare_spatiotemporal_dataset(InputFiles(12), CRU%NDepDataset) - ! For now, set the file index to 1 since we know its only one file - CRU%NDepDataset%CurrentFileIndx = 1 + ! Set up the nitrogen deposition reader (if defined in the namelist) + IF (TRIM(nDepFile) /= "None") THEN + CALL prepare_spatiotemporal_dataset(nDepFile, CRU%NDepDataset) + ! For now, set the file index to 1 since we know its only one file + CRU%NDepDataset%CurrentFileIndx = 1 - ok = NF90_OPEN(CRU%NDepDataset%Filenames(1), NF90_NOWRITE,& - CRU%NDepFID) - CALL handle_err(ok, "Opening NDep file") + ok = NF90_OPEN(CRU%NDepDataset%Filenames(1), NF90_NOWRITE,& + CRU%NDepFID) + CALL handle_err(ok, "Opening NDep file") - ok = NF90_INQ_VARID(CRU%NDepFID, "N_deposition",& - CRU%NDepVID) - CALL handle_err(ok, "Finding NDep variable") + ok = NF90_INQ_VARID(CRU%NDepFID, "N_deposition",& + CRU%NDepVID) + CALL handle_err(ok, "Finding NDep variable") + END IF END SUBROUTINE CRU_INIT - SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) ! Obtain one day of CRU-NCEP meteorology, subdiurnalise it using a weather @@ -156,7 +163,7 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) IMPLICIT NONE - TYPE(CRU_TYPE), INTENT(inout) :: CRU + TYPE(CRU_TYPE), INTENT(INOUT) :: CRU INTEGER, INTENT(IN) :: CurYear, ktau, kend ! Define MET the CABLE version, different from the MET defined and used @@ -240,7 +247,7 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) ! PRINT *, 'b4 daily ', etime, ' seconds needed ' LastDayOfYear = ktau == (kend-(nint(SecDay/dt)-1)) - call CRU_GET_DAILY_MET(CRU, LastDayOfYear) + call CRU_GET_DAILY_MET(CRU) ! Scale presuure to hPa CRU%Met(pres)%MetVals(:) = CRU%Met(pres)%MetVals(:) / 100. @@ -368,9 +375,8 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) end subroutine CRU_GET_SUBDIURNAL_MET -SUBROUTINE cru_get_daily_met(CRU, LastDayOfYear) +SUBROUTINE cru_get_daily_met(CRU) TYPE(CRU_TYPE), INTENT(INOUT) :: CRU - LOGICAL, INTENT(IN) :: LastDayOfYear ! The year of met forcing we use depends on our choice of configuration. ! Sometimes, recycle through a subset of data, and others we use the sim year. @@ -385,7 +391,7 @@ SUBROUTINE cru_get_daily_met(CRU, LastDayOfYear) INTEGER :: VarIndx ! Determine the recycled and sim year - RecycledYear = CRU%RecycStartYear + MOD(CRU%cYear - 1501, CRU%metRecyc) + RecycledYear = CRU%RecycStartYear + MOD(CRU%cYear - 1501, CRU%MetRecycPeriod) ! Iterate through the base variables IterateVariables: DO VarIndx = 1, CRU%nMet @@ -409,7 +415,7 @@ SUBROUTINE cru_get_daily_met(CRU, LastDayOfYear) ! opening and closing the io stream unnecessarily, but I think it's a minor ! evil. - ! Address prevTmax first + ! Address previous variables first ! Assume it's a regular day of the year DummyYear = CRU%cYear DummyDay = CRU%CTStep - 1 @@ -424,9 +430,10 @@ SUBROUTINE cru_get_daily_met(CRU, LastDayOfYear) END IF END IF - ! Was the Tmax recycled? + ! Now we have to handle each of the "prev" variables individually + ! Tmax IF (CRU%isRecycled(Tmax)) THEN - DummyYear = CRU%RecycStartYear + MOD(DummyYear - 1501, CRU%metRecyc) + DummyYear = CRU%RecycStartYear + MOD(DummyYear - 1501, CRU%MetRecycPeriod) END IF ! Now we just need to call cru_read_metvals with the Tmax Dataset reader and @@ -435,7 +442,31 @@ SUBROUTINE cru_get_daily_met(CRU, LastDayOfYear) land_y, DummyYear, DummyDay, CRU%LeapYears, CRU%xDimSize, CRU%yDimSize,& CRU%DirectRead) - ! Now do nextTmin + ! vp0900 + DummyYear = CRU%cYear + DummyDay = CRU%CTStep - 1 + + ! Special handling at the first day of the year + IF (CRU%CTSTEP == 1) THEN + ! Go back to previous year + DummyYear = CRU%cYear - 1 + DummyDay = 365 + IF ((CRU%LeapYears) .AND. (is_leapyear(DummyYear))) THEN + DummyDay = 366 + END IF + END IF + + IF (CRU%isRecycled(vp1500)) THEN + DummyYear = CRU%RecycStartYear + MOD(DummyYear - 1501, CRU%MetRecycPeriod) + END IF + + ! Now we just need to call cru_read_metvals with the Tmax Dataset reader and + ! the prevTmax array to write to + CALL read_metvals(CRU%MetDatasets(vp1500), CRU%Met(prevvp1500)%MetVals, land_x,& + land_y, DummyYear, DummyDay, CRU%LeapYears, CRU%xDimSize, CRU%yDimSize,& + CRU%DirectRead) + + ! Now do "next" variables ! Assume it's a regular day of the year DummyDay = CRU%CTStep + 1 DummyYear = CRU%cYear @@ -452,18 +483,43 @@ SUBROUTINE cru_get_daily_met(CRU, LastDayOfYear) DummyYear = CRU%cYear + 1 END IF - ! Was the Tmin recycled? + ! Now we have to handle each of the "next" variables individually + ! Tmax IF (CRU%isRecycled(Tmin)) THEN - DummyYear = CRU%RecycStartYear + MOD(DummyYear - 1501, CRU%metRecyc) + DummyYear = CRU%RecycStartYear + MOD(DummyYear - 1501, CRU%MetRecycPeriod) END IF CALL read_metvals(CRU%MetDatasets(Tmin), CRU%Met(nextTmin)%MetVals, land_x,& land_y, DummyYear, DummyDay, CRU%LeapYears, CRU%xDimSize, CRU%yDimSize,& CRU%DirectRead) + ! vp1500 + DummyDay = CRU%CTStep + 1 + DummyYear = CRU%cYear + + ! Special handling at the last day of the year + DaysInYear = 365 + IF ((CRU%LeapYears) .AND. (is_leapyear(DummyYear))) THEN + DaysInYear = 366 + END IF + + IF (CRU%CTStep == DaysInYear) THEN + ! We're at the end of a year + DummyDay = 1 + DummyYear = CRU%cYear + 1 + END IF + + IF (CRU%isRecycled(vp0900)) THEN + DummyYear = CRU%RecycStartYear + MOD(DummyYear - 1501, CRU%MetRecycPeriod) + END IF + + CALL read_metvals(CRU%MetDatasets(vp0900), CRU%Met(nextvp0900)%MetVals,& + land_x, land_y, DummyYear, DummyDay, CRU%LeapYears, CRU%xDimSize,& + CRU%yDimSize, CRU%DirectRead) END SUBROUTINE cru_get_daily_met -SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) +SUBROUTINE read_MET_namelist_cbl(InputFiles, nDepFile, CO2File, LandmaskFile,& + CRU) !*## Purpose ! ! Set the metadata for the met forcing. @@ -479,7 +535,8 @@ SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) ! pack them into a more convenient data structure. We don't expect the user ! to know the order in which we store the MET inputs internally, so we need ! to access them by name. - CHARACTER(LEN=256), DIMENSION(13), INTENT(OUT) :: InputFiles + CHARACTER(LEN=256), DIMENSION(nVariables), INTENT(OUT) :: InputFiles + CHARACTER(LEN=256), INTENT(OUT) :: CO2File, nDepFile, LandmaskFile TYPE(CRU_TYPE), INTENT(OUT) :: CRU ! The master CRU structure @@ -489,13 +546,14 @@ SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) ! expected in. So we first read them from a recognisable name, then pass them ! to the array. CHARACTER(LEN=256) :: rainFile, lwdnFile, swdnFile, presFile, qairFile,& - TmaxFile, TminFile, uwindFile, vwindFile, fdiffFile,& - CO2File, NDepFile, landmaskFile + TmaxFile, TminFile, uwindFile, vwindFile, windFile,& + vp0900File, vp1500File, fdiffFile LOGICAL :: rainRecycle, lwdnRecycle, swdnRecycle, presRecycle,& qairRecycle, TmaxRecycle, TminRecycle, uwindRecycle,& - vwindRecycle, fdiffRecycle + vwindRecycle, windRecycle, vp0900Recycle,& + vp1500Recycle, fdiffRecycle CHARACTER(LEN=16) :: CO2Method, NDepMethod - INTEGER :: MetRecyc, RecycStartYear + INTEGER :: MetRecycPeriod, RecycStartYear REAL :: DtHrs LOGICAL :: ReadDiffFrac, LeapYears, DirectRead @@ -508,9 +566,9 @@ SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) CO2File, NDepFile, landmaskFile,& rainRecycle, lwdnRecycle, swdnRecycle, presRecycle,& qairRecycle, TmaxRecycle, TminRecycle, uwindRecycle,& - vwindRecycle, fdiffRecycle,& - ReadDiffFrac, CO2Method, NDepMethod, MetRecyc, LeapYears,& - RecycStartYear, DtHrs, DirectRead + vwindRecycle, windRecycle, vp0900Recycle, vp1500Recycle,& + fdiffRecycle, ReadDiffFrac, CO2Method, NDepMethod,& + MetRecycPeriod, LeapYears, RecycStartYear, DtHrs, DirectRead ! Set the initial values for the filenames, as there are many instances where ! not all are required. We will set them all initially to "None", which we @@ -524,10 +582,13 @@ SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) TminFile = "None" uwindFile = "None" vwindFile = "None" + windFile = "None" + vp0900File = "None" + vp1500File = "None" fdiffFile = "None" CO2File = "None" NDepFile = "None" - landmaskFile = "None" + LandmaskFile = "None" ! For the recycling booleans rainRecycle = .FALSE. @@ -539,12 +600,15 @@ SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) TminRecycle = .FALSE. uwindRecycle = .FALSE. vwindRecycle = .FALSE. + windRecycle = .FALSE. + vp0900Recycle = .FALSE. + vp1500Recycle = .FALSE. fdiffRecycle = .FALSE. ! Defaults for the other inputs CO2Method = "Yearly" NDepMethod = "Yearly" - MetRecyc = 20 + MetRecycPeriod = 20 RecycStartYear = 1901 DtHrs = 3.0 LeapYears = .FALSE. @@ -567,10 +631,10 @@ SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) InputFiles(Tmin) = TminFile InputFiles(uwind) = uwindFile InputFiles(vwind) = vwindFile + InputFiles(wind) = windFile + InputFiles(vp0900) = vp0900File + InputFiles(vp1500) = vp1500File InputFiles(fdiff) = fdiffFile - InputFiles(11) = CO2File - InputFiles(12) = NDepFile - InputFiles(13) = landmaskFile ! Set the recycling booleans in the CRU struct CRU%IsRecycled(rain) = rainRecycle @@ -589,7 +653,7 @@ SUBROUTINE read_MET_namelist_cbl(InputFiles, CRU) CRU%NDepMethod = NDepMethod ! Convert the hourly timestep to seconds CRU%DtSecs = int(DtHrs * 3600.) - CRU%MetRecyc = MetRecyc + CRU%MetRecycPeriod= MetRecycPeriod CRU%RecycStartYear = RecycStartYear CRU%ReadDiffFrac = ReadDiffFrac CRU%LeapYears = LeapYears @@ -618,27 +682,25 @@ SUBROUTINE read_variable_names(STDatasets) ! contains, for each variable, the number of possible names to ```ALLOCATE``` ! string arrays, and then the string arrays themselves. - TYPE(SPATIO_TEMPORAL_DATASET), DIMENSION(10) :: STDatasets + TYPE(SPATIO_TEMPORAL_DATASET), DIMENSION(nVariables) :: STDatasets ! We need a unit to reference the namelist file, arrays to store the set of ! names for each variable, and integers to store how many names there are for - ! each variable. We set the size of the name arrays to 10 for now, because it - ! seems sufficient. If it ever ends up requiring more, it's probably an - ! indication we should switch to option 1. + ! each variable. INTEGER :: nmlUnit - CHARACTER(LEN=32), DIMENSION(10) :: rainNames, lwdnNames, swdnNames,& - presNames, qairNames, TmaxNames,& - TminNames, uWindNames, vWindNames,& - fdiffNames + CHARACTER(LEN=32) :: rainNames, lwdnNames, swdnNames, presNames, qairNames,& + TmaxNames, TminNames, uWindNames, vWindNames,& + windNames, vp0900Names, vp1500Names, fdiffNames INTEGER :: rainNo, lwdnNo, swdnNo, presNo, qairNo, TmaxNo, TminNo, uwindNo,& - vwindNo, fdiffNo + vwindNo, windNo, vp0900No, vp1500No, fdiffNo ! Set up and read the namelist NAMELIST /MetNames/ rainNames, lwdnNames, swdnNames, presNames, qairNames,& - TmaxNames, TminNames, uwindNames, vwindNames, fdiffNames,& + TmaxNames, TminNames, uwindNames, vwindNames, windNames,& + vp0900Names, vp1500Names, fdiffNames,& rainNo, lwdnNo, swdnNo, presNo, qairNo, TmaxNo, TminNo,& - uwindNo, vwindNo, fdiffNo + uwindNo, vwindNo, windNo, vp0900No, vp1500No, fdiffNo CALL get_unit(nmlUnit) OPEN(nmlUnit, FILE = "met_names.nml", STATUS = 'old', ACTION = 'read') @@ -650,7 +712,9 @@ SUBROUTINE read_variable_names(STDatasets) STDatasets(3)%VarNames(swdnNo), STDatasets(4)%VarNames(presNo),& STDatasets(5)%VarNames(qairNo), STDatasets(6)%VarNames(TmaxNo),& STDatasets(7)%VarNames(TminNo), STDatasets(8)%VarNames(uwindNo),& - STDatasets(9)%VarNames(vwindNo), STDatasets(10)%VarNames(fdiffNo)) + STDatasets(9)%VarNames(vwindNo), STDatasets(10)%VarNames(windNo),& + STDatasets(11)%VarNames(vp0900No), STDatasets(12)%VarNames(vp1500No),& + STDatasets(13)%VarNames(fdiffNo)) STDatasets(1)%VarNames = rainNames(1:rainNo) STDatasets(2)%VarNames = lwdnNames(1:lwdnNo) @@ -661,7 +725,11 @@ SUBROUTINE read_variable_names(STDatasets) STDatasets(7)%VarNames = TminNames(1:TminNo) STDatasets(8)%VarNames = uwindNames(1:uwindNo) STDatasets(9)%VarNames = vwindNames(1:vwindNo) - STDatasets(10)%VarNames = fdiffNames(1:fdiffNo) + STDatasets(10)%VarNames = windNames(1:windNo) + STDatasets(11)%VarNames = vp0900Names(1:vp0900No) + STDatasets(12)%VarNames = vp1500Names(1:vp1500No) + STDatasets(13)%VarNames = fdiffNames(1:fdiffNo) + END SUBROUTINE read_variable_names !------------------------------------------------------------------------------! diff --git a/offline/cable_input.F90 b/offline/cable_input.F90 index 1ef424813..5522219f4 100644 --- a/offline/cable_input.F90 +++ b/offline/cable_input.F90 @@ -162,6 +162,13 @@ MODULE cable_input_module ! index of the currently open file with the associated NetCDF file and variable ! ID. + ! A logical to check whether we should proceed with reading. With the merging + ! of the Met input interfaces, we have many more "possible" Met variables + ! than is required for a given weather generator. However, when we perform a + ! GET_SUBDIURNAL_MET call, we still iterate over all possible variables. This + ! gives us an easy out for variables that are not valid for the current set of + ! inputs. + LOGICAL :: IsInitialised = .FALSE. ! List of filenames in the dataset CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: FileNames ! The start and end years of each dataset @@ -3085,6 +3092,12 @@ SUBROUTINE prepare_spatiotemporal_dataset(FileTemplate, Dataset) ! Finished the work (we assign the VarNames later). Now delete the temporary ! file we used to store the `ls` output. CALL execute_command_line("rm __FileNameWithNoClashes__.txt") + + ! Open the dataset at the first file, so that it's ready for reading + CALL open_at_first_file(Dataset) + + Dataset.IsInitialised = .TRUE. + END SUBROUTINE prepare_spatiotemporal_dataset SUBROUTINE open_at_first_file(Dataset) @@ -3254,54 +3267,57 @@ SUBROUTINE read_metvals(STD, DataArr, LandIDx, LandIDy, Year, DayOfYear,& ! Temporary array to store the data read from file REAL, DIMENSION(:, :), ALLOCATABLE :: TmpArray - TimeIndex = DayOfYear - YearIndex = Year + ! Only act if the dataset is initialised + IF (STD%IsInitialised) THEN + TimeIndex = DayOfYear + YearIndex = Year - ! We've already opened a file, check whether the file containing the relevant - ! data is the one open - IF (.NOT. ((Year >= STD%StartYear(STD%CurrentFileIndx)) .AND.& - (Year <= STD%EndYear(STD%CurrentFileIndx)))) THEN - CALL open_new_data_file(STD, YearIndex, TimeIndex, LeapYears) - END IF + ! We've already opened a file, check whether the file containing the relevant + ! data is the one open + IF (.NOT. ((Year >= STD%StartYear(STD%CurrentFileIndx)) .AND.& + (Year <= STD%EndYear(STD%CurrentFileIndx)))) THEN + CALL open_new_data_file(STD, YearIndex, TimeIndex, LeapYears) + END IF - ! Now read the desired time step + ! Now read the desired time step - ! Due to leapyears, we can't just do add 365 * number of years from startyear. - IF (LeapYears) THEN - CountDays: DO YearIter = STD%StartYear(STD%CurrentFileIndx), YearIndex-1 - IF (is_leapyear(YearIndex)) THEN - TimeIndex = TimeIndex + 366 - ELSE - TimeIndex = TimeIndex + 365 - END IF - END DO CountDays - ELSE - TimeIndex = TimeIndex + 365 * (YearIndex -& - STD%StartYear(STD%CurrentFileIndx)) - END IF + ! Due to leapyears, we can't just do add 365 * number of years from startyear. + IF (LeapYears) THEN + CountDays: DO YearIter = STD%StartYear(STD%CurrentFileIndx), YearIndex-1 + IF (is_leapyear(YearIndex)) THEN + TimeIndex = TimeIndex + 366 + ELSE + TimeIndex = TimeIndex + 365 + END IF + END DO CountDays + ELSE + TimeIndex = TimeIndex + 365 * (YearIndex -& + STD%StartYear(STD%CurrentFileIndx)) + END IF - ! Now we have the index, we can grab the data - ! Read from the netCDF file to the masked array point by point - IF (DirectRead) THEN - ApplyMaskDirect: DO LandCell = 1, SIZE(LandIDx) - ok = NF90_GET_VAR(STD%CurrentFileID,& - STD%CurrentVarID, DataArr(LandCell), START = (/LandIDx(LandCell),& - LandIDy(LandCell), TimeIndex/)) - CALL handle_err(ok, "Failed reading "//TRIM(STD%FileNames& - (STD%CurrentFileIndx))//" in read_metvals.") - END DO ApplyMaskDirect - ELSE + ! Now we have the index, we can grab the data + ! Read from the netCDF file to the masked array point by point + IF (DirectRead) THEN + ApplyMaskDirect: DO LandCell = 1, SIZE(LandIDx) + ok = NF90_GET_VAR(STD%CurrentFileID,& + STD%CurrentVarID, DataArr(LandCell), START = (/LandIDx(LandCell),& + LandIDy(LandCell), TimeIndex/)) + CALL handle_err(ok, "Failed reading "//TRIM(STD%FileNames& + (STD%CurrentFileIndx))//" in read_metvals.") + END DO ApplyMaskDirect + ELSE - ALLOCATE(TmpArray(xDimSize, yDimSize)) + ALLOCATE(TmpArray(xDimSize, yDimSize)) - ok = NF90_GET_VAR(STD%CurrentFileID, STD%CurrentVarID, TmpArray,& - START = (/1, 1, TimeIndex/), COUNT = (/xDimSize, yDimSize, 1/)) - CALL handle_err(ok, "Failed reading "//TRIM(STD%FileNames& - (STD%CurrentFileIndx))//" in read_metvals.") + ok = NF90_GET_VAR(STD%CurrentFileID, STD%CurrentVarID, TmpArray,& + START = (/1, 1, TimeIndex/), COUNT = (/xDimSize, yDimSize, 1/)) + CALL handle_err(ok, "Failed reading "//TRIM(STD%FileNames& + (STD%CurrentFileIndx))//" in read_metvals.") - ApplyLandmaskIndirect: DO LandCell = 1, SIZE(LandIDx) - DataArr(LandCell) = TmpArray(LandIDx(LandCell), LandIDy(LandCell)) - END DO ApplyLandmaskIndirect + ApplyLandmaskIndirect: DO LandCell = 1, SIZE(LandIDx) + DataArr(LandCell) = TmpArray(LandIDx(LandCell), LandIDy(LandCell)) + END DO ApplyLandmaskIndirect + END IF END IF END SUBROUTINE read_metvals From ae27a7cfcc1b596691639a4d4efadf50ba88cb7f Mon Sep 17 00:00:00 2001 From: Whyborn Date: Mon, 16 Sep 2024 12:04:40 +1000 Subject: [PATCH 3/4] Move BIOS subdiurnal prep to the generalised routines. --- offline/cable_cru_TRENDY.F90 | 133 +++++++++++++++++++++++++++++++++-- 1 file changed, 128 insertions(+), 5 deletions(-) diff --git a/offline/cable_cru_TRENDY.F90 b/offline/cable_cru_TRENDY.F90 index 60b5fb4d7..c9f658894 100644 --- a/offline/cable_cru_TRENDY.F90 +++ b/offline/cable_cru_TRENDY.F90 @@ -156,7 +156,7 @@ SUBROUTINE CRU_INIT(CRU) END IF END SUBROUTINE CRU_INIT -SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) +SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau) ! Obtain one day of CRU-NCEP meteorology, subdiurnalise it using a weather ! generator and return the result to the CABLE driver. @@ -164,7 +164,7 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) IMPLICIT NONE TYPE(CRU_TYPE), INTENT(INOUT) :: CRU - INTEGER, INTENT(IN) :: CurYear, ktau, kend + INTEGER, INTENT(IN) :: CurYear, ktau ! Define MET the CABLE version, different from the MET defined and used ! within the CRU variable. @@ -172,6 +172,8 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) type(MET_TYPE) :: MET ! Local variables +I think the best approach would be to: + logical :: newday, LastDayOfYear ! Flags for occurence of a new day (0 hrs) and the last day of the year. INTEGER :: iland ! Loop counter through 'land' cells (cells in the spatial domain) INTEGER :: itimestep ! Loop counter through subdiurnal timesteps in a day @@ -245,9 +247,8 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) !print *, CRU%CTSTEP, ktau, kend ! CALL CPU_TIME(etime) ! PRINT *, 'b4 daily ', etime, ' seconds needed ' - LastDayOfYear = ktau == (kend-(nint(SecDay/dt)-1)) - call CRU_GET_DAILY_MET(CRU) + call GET_DAILY_MET(CRU) ! Scale presuure to hPa CRU%Met(pres)%MetVals(:) = CRU%Met(pres)%MetVals(:) / 100. @@ -375,7 +376,126 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend) end subroutine CRU_GET_SUBDIURNAL_MET -SUBROUTINE cru_get_daily_met(CRU) +SUBROUTINE BIOS_GET_SUBDIURNAL_MET(CRU, Met, CurYear, ktau) + !*## Purpose + ! + ! Use provided daily meteorology to prepare the inputs to the weather + ! generator. + ! + !## Method + ! + ! Uses the current date to retrieve the relevant entry from the respective + ! variable datasets, and process them into quantities appropriate for the + ! subdiurnal weather generator. + + TYPE(CRU_TYPE), INTENT(INOUT) :: CRU ! Meta information about the Met config + TYPE(MET_TYPE), INTENT(INOUT) :: Met ! The Met data storage + INTEGER, INTENT(IN) :: CurYear, ktau ! Time from the driver run loop + + LOGICAL :: NewDay ! New day checker + INTEGER :: iLand ! Land point iterator + INTEGER :: is, ie ! Tile iterators + + REAL, DIMENSION(:), ALLOCATABLE :: CO2Air ! CO2 concentration array + REAL, PARAMETER :: RMWbyRMA = 0.62188471 ! Mol wt H20 / atom wt C + + ! Set the current time + Met%hod(:) = REAL(MOD( (ktau-1) * NINT(dels), INT(SecDay)) ) / 3600. + Met%doy(:) = INT(REAL(ktau-1) * dels / SecDay ) + 1 + Met%year(:) = CurYear + + CALL DOYSOD2YMDHMS(CurYear, INT(MET%doy(1)), INT(met%hod(1)) * 3600, dM, dD) + Met%moy(:) = dM + + ! Check for a new day + NewDay = EQ(Met%hod(landpt(1)%cstart), 0.0) + + ! Allocate CO2 memory + ALLOCATE(CO2Air(SIZE(Met%ca)) + + ! Beginning of year accounting + IF (ktau == 1) THEN + CRU%CTStep = 1 + ! Read a new annual CO2 value and convert it from ppm to mol/mol + CALL GET_CRU_CO2(CRU, CO2air) + Met%ca(:) = CO2air(:) / 1.0e6 + + CALL GET_CRU_Ndep(CRU) + DO iland = 1, CRU%mland + Met%Ndep(landpt(iland)%cstart:landpt(iland)%cend) = & + CRU%NdepVALS(iland)*86400000. ! kg/m2/s > g/m2/d (1000.*3600.*24.) + END DO + END IF + + ! Beginning of day accounting + IF (NewDay) THEN + CALL GET_DAILY_MET(CRU) + + ! Map to weather generator + WG%TempMinDay = CRU%Met(Tmin)%MetVals + WG%TempMaxDay = CRU%Met(Tmax)%MetVals + + WG%VapPmbDay = ESATF(CRU%Met(Tmin)%MetVals + WG%VapPmb0900 = CRU%Met(vp0900)%MetVals + WG%VapPmb1500 = CRU%Met(vp1500)%MetVals + + ! NOTE- this section is incorrect, and is currently left incorrect for + ! bitwise compatibility. + ! TODO: Correct this after bitwise comparisons to incorrect version + WG%TempMaxDayPrev = CRU%Met(Tmax)%MetVals + WG%TempMinDayNext = CRU%Met(Tmin)%MetVals + WG%VapPmb1500Prev = CRU%Met(vp1500)%MetVals + WG%VapPmb0900Next = CRU%Met(vp0900)%MetVals + + ! End TODO + ! Continue mapping to weather generator + WG%WindDay = CRU%Met(wind)%MetVals + WG%SolarMJDay = CRU%Met(swdn)%MetVals + WG%PrecipDay = CRU%Met(rain)%MetVals / 1000 + WG%PmbDay = 1000.0 + + ! Do snow conversion + SnowConversion: DO iLand = 1, SIZE(WG%TempMinDay) + IF WG%TempMinDay(iLand) < -2.0) THEN + WG%SnowDay(iLand) = WG%PrecipDay(iLand) + WG%PrecipDay(iLand) = 0.0 + ELSE + WG%SnowDay(iLand) = 0.0 + END IF + END DO SnowConversion + END IF ! End start of day accounting + + CALL WGEN_SUBDIURNAL_MET(WG, CRU%mLand, NINT(Met%hod(1) * 3600.0 / dt)) + + ! Now pass the data out to the land tiles + PassToTiles: DO iLand = 1, CRU%mLand + is = LandPt(iLand)%cStart + ie = LandPt(iLand)%cEnd + + Met%Precip(is:ie) = REAL(WG%Precip(iLand), sp) + Met%Precip_sn(is:ie) = REAL(WG%Snow(iLand), sp) + ! Why is it done this way? Doesn't make much sense + Met%Precip(is:ie) = Met%Precip(is:ie) + Met%Precip_sn(is:ie) + Met%fld(is:ie) = REAL(WG%PhilD(iLand), sp) + Met%fsd(is:ie,1) = REAL(WG%PhiSD(iLand) * 0.5_dp, sp) + Met%fsd(is:ie,2) = REAL(WG%PhiSD(iLand) * 0.5_dp, sp) + Met%tk(is:ie) = REAL(WG%Temp(iLand) + 273.15_dp, sp) + ! Factor of 2 to convert 2m screen height to 40m zref (??) + Met%ua(is:ie) = REAL(WG%Wind(iLand) * 2.0_dp, sp) + Met%coszen(is:ie) = REAL(WG%coszen(iLand), sp) + Met%qv(is:ie) = REAL(WG%VapPmb(iLand) / WG%Pmb(iLand), sp) *& + RMWbyRWA + Met%Pmb(is:ie) = REAL(WG%Pmb(iLand), sp) + Met%rhum(is:ie) = REAL(WG%VapPmb(iLand), sp) /& + ESATF(REAL(WG%Temp(iLand), sp)) * 100.0 + Met%u10(is:ie) = Met%ua(is:ie) + Met%tvair(is:ie) = Met%tk(is:ie) + Met%tvrad(is:ie) = Met%tk(is:ie) + END DO PassToTiles + +END SUBROUTINE BIOS_GET_SUBDIURNAL_MET + +SUBROUTINE get_daily_met(CRU) TYPE(CRU_TYPE), INTENT(INOUT) :: CRU ! The year of met forcing we use depends on our choice of configuration. @@ -800,6 +920,9 @@ SUBROUTINE read_landmask(LandmaskFile, CRU) ALLOCATE(LandMask(xDimSize, yDimSize)) ALLOCATE(CRU%LandMask(xDimSize, yDimSize)) ok = NF90_INQ_VARID(FileID, 'land', LandID) + IF (ok == NF90_NOERR) THEN + ok = NF90_INQ_VARID(FileID, 'AWAP BIOS Australia Mask (modelled=1, not modelled = -9999)', LandID) + END IF CALL handle_err(ok, "Error finding land VARID.") ok = NF90_GET_VAR(FileID, LandID, LandMask) CALL handle_err(ok, "Error reading land variable.") From c01cfaa1a2bf9e3a26a7e04c4d990834444495f0 Mon Sep 17 00:00:00 2001 From: Whyborn Date: Mon, 16 Sep 2024 15:05:59 +1000 Subject: [PATCH 4/4] Various minor fixes for compilation. --- offline/cable_cru_TRENDY.F90 | 30 +++++++++++++++++++----------- offline/cable_driver.F90 | 13 ++++++++----- 2 files changed, 27 insertions(+), 16 deletions(-) diff --git a/offline/cable_cru_TRENDY.F90 b/offline/cable_cru_TRENDY.F90 index c9f658894..c6b632a04 100644 --- a/offline/cable_cru_TRENDY.F90 +++ b/offline/cable_cru_TRENDY.F90 @@ -42,8 +42,10 @@ MODULE CABLE_CRU fdiff = 13, prevTmax = 14, nextTmin = 15,& nextvp0900 = 16, prevvp1500 = 17 INTEGER, PRIVATE, PARAMETER :: sp = kind(1.0) +INTEGER, PRIVATE, PARAMETER :: dp = KIND(1.0d0) INTEGER, PRIVATE, PARAMETER :: nVariables = 13 INTEGER, PRIVATE :: ErrStatus +TYPE(WEATHER_GENERATOR_TYPE), PRIVATE :: WG TYPE CRU_MET_TYPE REAL, DIMENSION(:), ALLOCATABLE :: MetVals @@ -154,6 +156,10 @@ SUBROUTINE CRU_INIT(CRU) CRU%NDepVID) CALL handle_err(ok, "Finding NDep variable") END IF + + ! Initialise the weather generator + CALL WGEN_INIT(WG, CRU%mLand, Latitude, REAL(CRU%DtSecs)) + END SUBROUTINE CRU_INIT SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau) @@ -172,7 +178,6 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau) type(MET_TYPE) :: MET ! Local variables -I think the best approach would be to: logical :: newday, LastDayOfYear ! Flags for occurence of a new day (0 hrs) and the last day of the year. INTEGER :: iland ! Loop counter through 'land' cells (cells in the spatial domain) @@ -183,7 +188,6 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau) REAL :: dt ! Timestep in seconds ! Store the CO2Air as an array REAL, DIMENSION(:), ALLOCATABLE :: CO2air ! CO2 concentration in ppm - type(WEATHER_GENERATOR_TYPE), save :: WG logical, save :: CALL1 = .true. ! A *local* variable recording the first call of this routine INTEGER :: VarIter @@ -197,7 +201,6 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau) cable_user%calc_fdiff = .true. endif - call WGEN_INIT(WG, CRU%mland, latitude, dt) endif ! Pass time-step information to CRU @@ -395,13 +398,18 @@ SUBROUTINE BIOS_GET_SUBDIURNAL_MET(CRU, Met, CurYear, ktau) LOGICAL :: NewDay ! New day checker INTEGER :: iLand ! Land point iterator INTEGER :: is, ie ! Tile iterators + INTEGER :: dM, dD ! date month and day + REAL :: Dt ! Timestep as real (why is not real originally?) REAL, DIMENSION(:), ALLOCATABLE :: CO2Air ! CO2 concentration array REAL, PARAMETER :: RMWbyRMA = 0.62188471 ! Mol wt H20 / atom wt C + ! Convert timestep to real + Dt = CRU%DtSecs + ! Set the current time - Met%hod(:) = REAL(MOD( (ktau-1) * NINT(dels), INT(SecDay)) ) / 3600. - Met%doy(:) = INT(REAL(ktau-1) * dels / SecDay ) + 1 + Met%hod(:) = REAL(MOD((ktau-1) * NINT(Dt), INT(SecDay))) / 3600. + Met%doy(:) = INT(REAL(ktau-1) * Dt / SecDay ) + 1 Met%year(:) = CurYear CALL DOYSOD2YMDHMS(CurYear, INT(MET%doy(1)), INT(met%hod(1)) * 3600, dM, dD) @@ -411,7 +419,7 @@ SUBROUTINE BIOS_GET_SUBDIURNAL_MET(CRU, Met, CurYear, ktau) NewDay = EQ(Met%hod(landpt(1)%cstart), 0.0) ! Allocate CO2 memory - ALLOCATE(CO2Air(SIZE(Met%ca)) + ALLOCATE(CO2Air(SIZE(Met%ca))) ! Beginning of year accounting IF (ktau == 1) THEN @@ -435,7 +443,7 @@ SUBROUTINE BIOS_GET_SUBDIURNAL_MET(CRU, Met, CurYear, ktau) WG%TempMinDay = CRU%Met(Tmin)%MetVals WG%TempMaxDay = CRU%Met(Tmax)%MetVals - WG%VapPmbDay = ESATF(CRU%Met(Tmin)%MetVals + WG%VapPmbDay = ESATF(CRU%Met(Tmin)%MetVals) WG%VapPmb0900 = CRU%Met(vp0900)%MetVals WG%VapPmb1500 = CRU%Met(vp1500)%MetVals @@ -456,7 +464,7 @@ SUBROUTINE BIOS_GET_SUBDIURNAL_MET(CRU, Met, CurYear, ktau) ! Do snow conversion SnowConversion: DO iLand = 1, SIZE(WG%TempMinDay) - IF WG%TempMinDay(iLand) < -2.0) THEN + IF (WG%TempMinDay(iLand) < -2.0) THEN WG%SnowDay(iLand) = WG%PrecipDay(iLand) WG%PrecipDay(iLand) = 0.0 ELSE @@ -465,7 +473,7 @@ SUBROUTINE BIOS_GET_SUBDIURNAL_MET(CRU, Met, CurYear, ktau) END DO SnowConversion END IF ! End start of day accounting - CALL WGEN_SUBDIURNAL_MET(WG, CRU%mLand, NINT(Met%hod(1) * 3600.0 / dt)) + CALL WGEN_SUBDIURNAL_MET(WG, CRU%mLand, NINT(Met%hod(1) * 3600.0 / Dt)) ! Now pass the data out to the land tiles PassToTiles: DO iLand = 1, CRU%mLand @@ -484,7 +492,7 @@ SUBROUTINE BIOS_GET_SUBDIURNAL_MET(CRU, Met, CurYear, ktau) Met%ua(is:ie) = REAL(WG%Wind(iLand) * 2.0_dp, sp) Met%coszen(is:ie) = REAL(WG%coszen(iLand), sp) Met%qv(is:ie) = REAL(WG%VapPmb(iLand) / WG%Pmb(iLand), sp) *& - RMWbyRWA + RMWbyRMA Met%Pmb(is:ie) = REAL(WG%Pmb(iLand), sp) Met%rhum(is:ie) = REAL(WG%VapPmb(iLand), sp) /& ESATF(REAL(WG%Temp(iLand), sp)) * 100.0 @@ -636,7 +644,7 @@ SUBROUTINE get_daily_met(CRU) CALL read_metvals(CRU%MetDatasets(vp0900), CRU%Met(nextvp0900)%MetVals,& land_x, land_y, DummyYear, DummyDay, CRU%LeapYears, CRU%xDimSize,& CRU%yDimSize, CRU%DirectRead) -END SUBROUTINE cru_get_daily_met +END SUBROUTINE get_daily_met SUBROUTINE read_MET_namelist_cbl(InputFiles, nDepFile, CO2File, LandmaskFile,& CRU) diff --git a/offline/cable_driver.F90 b/offline/cable_driver.F90 index 0af2233a4..148f616f6 100644 --- a/offline/cable_driver.F90 +++ b/offline/cable_driver.F90 @@ -125,7 +125,8 @@ PROGRAM cable_offline_driver use CABLE_PLUME_MIP, only: PLUME_MIP_TYPE, PLUME_MIP_GET_MET, & PLUME_MIP_INIT - use CABLE_CRU, only: CRU_TYPE, CRU_GET_SUBDIURNAL_MET, CRU_INIT, cru_close + use CABLE_CRU, only: CRU_TYPE, CRU_GET_SUBDIURNAL_MET,& + BIOS_GET_SUBDIURNAL_MET, CRU_INIT, cru_close use CABLE_site, only: site_TYPE, site_INIT, site_GET_CO2_Ndep ! BIOS only @@ -516,7 +517,7 @@ PROGRAM cable_offline_driver NREP: do RRRR=1, NRRRR if (trim(cable_user%MetType) == "bios") then - call cable_bios_init(dels,curyear,met,kend,ktauday) + !call cable_bios_init(dels,curyear,met,kend,ktauday) koffset = 0 leaps = .true. write(str1,'(i4)') curyear @@ -591,7 +592,8 @@ PROGRAM cable_offline_driver else if (trim(cable_user%MetType) == 'bios') then ! BIOS run kend = nint(24.0 * 3600.0 / dels) * LOY - else if (trim(cable_user%MetType) == 'cru') then + else if ((trim(cable_user%MetType) == 'cru') .OR. & + (TRIM(cable_user%MetType) == 'bios')) then ! TRENDY experiment using CRU-NCEP if (CALL1) then call cru_init(cru) @@ -837,11 +839,11 @@ PROGRAM cable_offline_driver end if else if (trim(cable_user%MetType) == 'bios') then if ((.not. CASAONLY) .or. (CASAONLY .and. CALL1)) then - call cable_bios_read_met(MET, CurYear, ktau, dels) + call BIOS_GET_SUBDIURNAL_MET(CRU, met, YYYY, ktau) end if else if (trim(cable_user%MetType) == 'cru') then if ((.not. CASAONLY) .or. (CASAONLY .and. CALL1)) then - call CRU_GET_SUBDIURNAL_MET(CRU, met, YYYY, ktau, kend) + call CRU_GET_SUBDIURNAL_MET(CRU, met, YYYY, ktau) end if else if (trim(cable_user%MetType) == 'site') & @@ -1296,6 +1298,7 @@ PROGRAM cable_offline_driver CALL1 = .false. + WRITE(*,*) "Spinup:", spinup, "spinConv:", spinConv, "CASAONLY:", CASAONLY ! see if spinup (if conducting one) has converged if (spinup .and. (.not.spinConv) .and. (.not.CASAONLY)) then