From 8dbee2030a35edb3124bb349c16d5f0e7f8c0821 Mon Sep 17 00:00:00 2001 From: David Mocko Date: Tue, 16 Jul 2024 15:46:11 -0400 Subject: [PATCH 01/12] Add NLDAS-2 netCDF-4 LIS metforcing reader This pull request adds the NLDAS-2 v020 netCDF-4 LIS metforcing reader into the LIS code. As the v002 GRIB-1 NLDAS-2 data and the v020 netCDF-4 NLDAS-2 data are nearly identical (within round-off error) - the two metforcing readers in LIS also produce nearly identical results. Note that as part of this pull request, the "Met forcing sources:" option for the NLDAS-2 v002 GRIB-1 data has changed from "NLDAS2" to "NLDAS2 grib". To use the new v020 netCDF-4 metforcing reader, please use "NLDAS2 netcdf" for "Met forcing sources:". Resolves: #1577 --- docs/LIS_users_guide/user_cfg_table.adoc | 3 +- lis/configs/lis.config.adoc | 122 ++++- lis/make/default.cfg | 5 + lis/metforcing/nldas-2.0/0Intro_nldas20.txt | 23 + lis/metforcing/nldas-2.0/finalize_nldas20.F90 | 75 +++ .../nldas-2.0/get_netcdf4_filenames.F90 | 223 ++++++++ lis/metforcing/nldas-2.0/get_nldas20.F90 | 272 ++++++++++ .../nldas-2.0/nldas20_ec_removal.F90 | 120 +++++ .../nldas-2.0/nldas20_forcingMod.F90 | 338 ++++++++++++ .../nldas-2.0/read_nldas20_elev.F90 | 97 ++++ lis/metforcing/nldas-2.0/read_nldas20a.F90 | 379 ++++++++++++++ lis/metforcing/nldas-2.0/read_nldas20b.F90 | 331 ++++++++++++ .../nldas-2.0/read_orig_nldas20_elevdiff.F90 | 79 +++ lis/metforcing/nldas-2.0/readcrd_nldas20.F90 | 121 +++++ lis/metforcing/nldas-2.0/reset_nldas20.F90 | 40 ++ .../nldas-2.0/timeinterp_nldas20.F90 | 485 ++++++++++++++++++ lis/plugins/LIS_metforcing_pluginMod.F90 | 23 +- lis/plugins/LIS_pluginIndices.F90 | 4 +- 18 files changed, 2723 insertions(+), 17 deletions(-) create mode 100644 lis/metforcing/nldas-2.0/0Intro_nldas20.txt create mode 100644 lis/metforcing/nldas-2.0/finalize_nldas20.F90 create mode 100644 lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 create mode 100644 lis/metforcing/nldas-2.0/get_nldas20.F90 create mode 100644 lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 create mode 100644 lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 create mode 100644 lis/metforcing/nldas-2.0/read_nldas20_elev.F90 create mode 100644 lis/metforcing/nldas-2.0/read_nldas20a.F90 create mode 100644 lis/metforcing/nldas-2.0/read_nldas20b.F90 create mode 100644 lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 create mode 100644 lis/metforcing/nldas-2.0/readcrd_nldas20.F90 create mode 100644 lis/metforcing/nldas-2.0/reset_nldas20.F90 create mode 100644 lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 diff --git a/docs/LIS_users_guide/user_cfg_table.adoc b/docs/LIS_users_guide/user_cfg_table.adoc index 63962d576..8e03b7d5d 100644 --- a/docs/LIS_users_guide/user_cfg_table.adoc +++ b/docs/LIS_users_guide/user_cfg_table.adoc @@ -31,7 +31,8 @@ | GSWP2 | On | AGRMET | Off | PRINCETON | On -| NLDAS2 | On +| NLDAS2 grib | On +| NLDAS2 netcdf | On | GLDAS | On | GFS | On | MERRA2 | On diff --git a/lis/configs/lis.config.adoc b/lis/configs/lis.config.adoc index f446d2fea..e3d04a0c5 100644 --- a/lis/configs/lis.config.adoc +++ b/lis/configs/lis.config.adoc @@ -346,7 +346,8 @@ Acceptable values for the sources are: |"`GSWP2`" | GSWP2 |"`AGRMET`" | AGRMET |"`PRINCETON`" | Princeton -|"`NLDAS2`" | NLDAS2 +|"`NLDAS2 grib`" | NLDAS-2 GRIB-1 format +|"`NLDAS2 netcdf`" | NLDAS-2 v020 netCDF-4 format |"`GLDAS`" | GLDAS |"`GFS`" | GFS |"`MERRA2`" | MERRA2 @@ -5873,15 +5874,14 @@ SCAN forcing directory: ./input/FORCING/SCAN SCAN metadata file: ./input/FORCING/SCAN/msu_scan.mdata .... - [[sssec_forcings_nldas2,NLDAS2]] ==== NLDAS2 -`NLDAS2 forcing directory:` specifies the location of the NLDAS2 -forcing files. +`NLDAS2 forcing directory:` specifies the location of the NLDAS-2 +GRIB-1 forcing files. -`NLDAS2 data center source:` specifies the center that produced -the NLDAS2 files. (This is specified to distinguish the filenames.) +`NLDAS2 data center source:` specifies the center that produced the +NLDAS-2 GRIB-1 files. (This is specified to distinguish the filenames.) Acceptable values are: |==== @@ -5893,7 +5893,7 @@ Acceptable values are: `NLDAS2 use model level data:` specifies whether or not to read in the model level data (instead of 2/10m fields) from the -NLDAS2 forcing dataset (will open up and read "`B`" files). +NLDAS-2 forcing dataset (will open up and read "`B`" files). This data is at the height of the NARR lowest model level. Note that this will read in "`Height of Atmospheric Forcing`" @@ -5910,7 +5910,7 @@ Acceptable values are: `NLDAS2 use model based swdown:` specifies whether or not to read in the un-bias corrected model downward shortwave radiation -data (in leiu of the bias corrected data) from the NLDAS2 forcing +data (in leiu of the bias corrected data) from the NLDAS-2 forcing dataset (will open up and read "`B`" files). The data source is the NARR shortwave. Acceptable values are: @@ -5924,7 +5924,7 @@ Acceptable values are: `NLDAS2 use model based precip:` specifies whether or not to read in the model based precipitation data (instead of the -observation based precipitation) from the NLDAS2 forcing +observation based precipitation) from the NLDAS-2 forcing dataset (will open up and read "`B`" files). The data source is the NARR precipitation. Acceptable values are: @@ -5936,10 +5936,9 @@ Acceptable values are: |1 | use |==== -`NLDAS2 use model based pressure:` specifies whether or -not to read in the model base pressure data (instead of the -observation based pressure) from the NLDAS2 forcing dataset -(will open up and read "`B`" files). The data source is +`NLDAS2 use model based pressure:` specifies whether or not +to read in the model base pressure data from the NLDAS-2 forcing +dataset (will open up and read "`B`" files). The data source is the pressure at the NARR lowest model level. Acceptable values are: @@ -5960,6 +5959,103 @@ NLDAS2 use model based precip: 0 NLDAS2 use model based pressure: 0 .... +[[sssec_forcings_nldas20,NLDAS20]] +==== NLDAS-2.0 + +`NLDAS-2.0 FORA forcing directory:` specifies the location of the +NLDAS-2.0 v020 "`FORA`" netCDF-4 forcing files. + +`NLDAS-2.0 FORB forcing directory:` specifies the location of the +NLDAS-2.0 v020 "`FORB`" netCDF-4 forcing files. This config entry +is not required unless one of the following FORB data use flags is +set to "`1`". + +`NLDAS-2.0 use FORB model level data:` specifies whether or not to +read in and use the model level data (instead of 2/10-m fields) from +the NLDAS-2 "`FORB`" forcing dataset. This data is at the height +of the NARR lowest model level. The fields that are used are air +temperature, air humidity, winds, height of the lowest model level, +and the aerodynamic conductance. This config entry is not required, +and the default will be to not use this FORB data. However, if the +FORB model level data is chosen, you must specify the directory of +the FORB data using the "`NLDAS-2.0 FORB forcing directory:`" config. + +Note that this will read in "`Height of Atmospheric Forcing`" +and "`Surface Exchange Coefficient for Heat`" (aka, aerodynamic +conductance). You must make sure that "`Forc_Hgt:`" and "`Ch:`" +(respectively) are included in your forcing variables list file. + +Acceptable values are: + +|==== +|Value | Description + +|0 | do not use +|1 | use +|==== + +`NLDAS-2.0 use FORB model-based SWdown:` specifies whether or not +to read in and use the un-bias-corrected model downward shortwave +radiation data (in leiu of the bias-corrected data) from the NLDAS-2 +"`FORB`" forcing dataset. The data source is the NARR shortwave. +This config entry is not required, and the default will be to not +use this FORB data. However, if the FORB model-based SWdown is +chosen, you must specify the directory of the FORB data using the +"`NLDAS-2.0 FORB forcing directory:`" config. +Acceptable values are: + +|==== +|Value | Description + +|0 | do not use +|1 | use +|==== + +`NLDAS-2.0 use FORB model-based precip:` specifies whether or not +to read in and use the model-based precipitation data (instead of +the observation-based precipitation) from the NLDAS-2 "`FORB`" +forcing dataset. The data source is the NARR precipitation. +This config entry is not required, and the default will be to not +use this FORB data. However, if the FORB model-based precip is +chosen, you must specify the directory of the FORB data using the +"`NLDAS-2.0 FORB forcing directory:`" config. +Acceptable values are: + +|==== +|Value | Description + +|0 | do not use +|1 | use +|==== + +`NLDAS-2.0 use FORB model-based pressure:` specifies whether or +not to read in and use the pressure data from the NLDAS-2 "`FORB`" +forcing dataset. This data is at the height of the NARR lowest +model level. This config entry is not required, and the default +will be to not use this FORB data. However, if the FORB model-based +pressure is chosen, you must specify the directory of the FORB data +using the "`NLDAS-2.0 FORB forcing directory:`" config. +Acceptable values are: + +Acceptable values are: + +|==== +|Value | Description + +|0 | do not use +|1 | use +|==== + +.Example _lis.config_ entry +.... +NLDAS-2.0 FORA forcing directory: ./input/NLDAS2/FORA +NLDAS-2.0 FORB forcing directory: ./input/NLDAS2/FORB +NLDAS-2.0 use FORB model level data: 0 +NLDAS-2.0 use FORB model-based SWdown: 0 +NLDAS-2.0 use FORB model-based precip: 0 +NLDAS-2.0 use FORB model-based pressure: 0 +.... + [[sssec_forcings_COAMPS,COAMPS]] ==== COAMPS diff --git a/lis/make/default.cfg b/lis/make/default.cfg index 8b7538b29..8228d2bdd 100644 --- a/lis/make/default.cfg +++ b/lis/make/default.cfg @@ -267,6 +267,11 @@ enabled: True macro: MF_NLDAS2 path: metforcing/nldas2 +[NLDAS20] +enabled: True +macro: MF_NLDAS20 +path: metforcing/nldas-2.0 + [GLDAS] enabled: True macro: MF_GLDAS diff --git a/lis/metforcing/nldas-2.0/0Intro_nldas20.txt b/lis/metforcing/nldas-2.0/0Intro_nldas20.txt new file mode 100644 index 000000000..5a8fb65a7 --- /dev/null +++ b/lis/metforcing/nldas-2.0/0Intro_nldas20.txt @@ -0,0 +1,23 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +! +!BOP +!\section{NLDAS20} +!The atmospheric forcing used in the North American Land Data +!Assimilation System Phase 2 (NLDAS-2) features products at an +!hourly 0.125$^\circ$ spatial resolution, from 25 to 53 North +!and from -125 to -67 West, from January 1979 to present. +!For details, see Xia et al. (2012, JGR) and visit: +! https://ldas.gsfc.nasa.gov/nldas/v2/forcing +! +!This metforcing reader handles the netcdf-4 version 020 format +!of the NLDAS-2 forcing available from the NASA GES DISC. +! +!EOP diff --git a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 new file mode 100644 index 000000000..507744f69 --- /dev/null +++ b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 @@ -0,0 +1,75 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! !MODULE: finalize_nldas20 +! \label{finalize_nldas20} +! +! !REVISION HISTORY: +! 25 Oct 2005: Sujay Kumar, Initial Code +! 24 Aug 2007: Chuck Alonge, Modified for use with NLDAS-2 data +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine finalize_nldas20(findex) +! !USES: + use LIS_coreMod, only : LIS_rc + use nldas20_forcingMod, only : nldas20_struc + + implicit none +! !ARGUMENTS: + integer :: findex +! +! !DESCRIPTION: +! Routine to cleanup nldas20 forcing related memory allocations. +! +!EOP + integer :: n + + do n = 1,LIS_rc%nnest + if (trim(LIS_rc%met_interp(findex)).eq."bilinear") then + deallocate(nldas20_struc(n)%n111) + deallocate(nldas20_struc(n)%n121) + deallocate(nldas20_struc(n)%n211) + deallocate(nldas20_struc(n)%n221) + deallocate(nldas20_struc(n)%w111) + deallocate(nldas20_struc(n)%w121) + deallocate(nldas20_struc(n)%w211) + deallocate(nldas20_struc(n)%w221) + elseif (trim(LIS_rc%met_interp(findex)).eq."budget-bilinear") & + then + deallocate(nldas20_struc(n)%n111) + deallocate(nldas20_struc(n)%n121) + deallocate(nldas20_struc(n)%n211) + deallocate(nldas20_struc(n)%n221) + deallocate(nldas20_struc(n)%w111) + deallocate(nldas20_struc(n)%w121) + deallocate(nldas20_struc(n)%w211) + deallocate(nldas20_struc(n)%w221) + deallocate(nldas20_struc(n)%n112) + deallocate(nldas20_struc(n)%n122) + deallocate(nldas20_struc(n)%n212) + deallocate(nldas20_struc(n)%n222) + deallocate(nldas20_struc(n)%w112) + deallocate(nldas20_struc(n)%w122) + deallocate(nldas20_struc(n)%w212) + deallocate(nldas20_struc(n)%w222) + elseif(trim(LIS_rc%met_interp(findex)).eq."neighbor") then + deallocate(nldas20_struc(n)%n113) + endif + + if (LIS_rc%met_ecor(findex).ne."none") then + deallocate(nldas20_struc(n)%orig_ediff) + endif + enddo + deallocate(nldas20_struc) + + end subroutine finalize_nldas20 + diff --git a/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 new file mode 100644 index 000000000..7104fd288 --- /dev/null +++ b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 @@ -0,0 +1,223 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: netcdf4_nldas20filea +! \label{netcdf4_nldas20filea} +! +! !REVISION HISTORY: +! 1 Oct 1999: Jared Entin; Initial code +! 15 Oct 1999: Paul Houser; Significant F90 Revision +! 04 Sep 2001: Brian Cosgrove; Use of NASA data enabled, updated +! reading of data directory structure to read new format +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data +! 22 Jan 2012: K. Arsenault; Accommodate GES DISC, NCEP/EMC filename conventions +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine netcdf4_nldas20filea(n,kk,findex,filename, & + nldas20dir,yr,mo,da,doy,hr) +! !USES: + use LIS_coreMod + use LIS_logMod + use LIS_forecastMod + + implicit none +! !ARGUMENTS: + integer :: n + integer :: kk + integer :: findex + character(len=*), intent(out) :: filename + character(len=*), intent(in) :: nldas20dir + integer, intent(in) :: yr,mo,da,doy,hr +! +! !DESCRIPTION: +! This subroutine assembles GES DISC NLDAS-2 netCDF-4 "A" filenames +! for 1 hour file intervals. +! +! The arguments are: +! \begin{description} +! \item[nldas20dir] +! Name of the NLDAS-2 directory +! \item[yr] +! year +! \item[mo] +! month +! \item[da] +! day of month +! \item[doy] +! Julian day of year (needed for subdirectory structure) +! \item[hr] +! hour of day +! \item[filename] +! name of the timestamped GES DISC NLDAS-2 netCDF-4 file +! \end{description} +! +!EOP + character*4 :: fyr + character*3 :: fdoy + character*2 :: fmo, fda, fhr + integer :: doy2 + +!=== end variable definition =========================================== + + if (LIS_rc%forecastMode.eq.0) then !hindcast run + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fdoy,fmt="(i3.3)") doy + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr + +!=== Assemble GES DISC NLDAS-2 netCDF-4 FORA filename: + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" + + else ! forecast mode + doy2 = doy +! IF Forecast Year is a leap years, for doy: + if ((mod(LIS_rc%yr,4).eq.0.and.mod(LIS_rc%yr,100).ne.0) & + .or.(mod(LIS_rc%yr,400).eq.0)) then + if (doy.gt.59) then ! Make sure to remove extra day + doy2 = doy - 1 + endif + endif + +! Sample yr, mo, da + call LIS_sample_forecastDate(n,kk,findex,yr,mo,da) + +! Account for member year - leap years for doy: + if ((mod(yr,4).eq.0.and.mod(yr,100).ne.0) & + .or.(mod(yr,400).eq.0)) then + if (doy.gt.59) then + doy2 = doy2 + 1 + endif + endif + + write(unit=fdoy,fmt="(i3.3)") doy2 + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr + +!=== Assemble GES DISC NLDAS-2 netCDF-4 FORA filename: + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" + endif + + end subroutine netcdf4_nldas20filea + +!BOP +! !ROUTINE: netcdf4_nldas20fileb +! \label{netcdf4_nldas20fileb} +! +! !REVISION HISTORY: +! 1 Oct 1999: Jared Entin; Initial code +! 15 Oct 1999: Paul Houser; Significant F90 Revision +! 04 Sep 2001: Brian Cosgrove; Use of NASA data enabled, updated +! reading of data directory structure to read new format +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data +! 22 Jan 2012: K. Arsenault; Accommodate GES DISC, GES DISC filename conventions +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine netcdf4_nldas20fileb(n,kk,findex,filename, & + nldas20dir,yr,mo,da,doy,hr) +! !USES: + use LIS_coreMod + use LIS_logMod + use LIS_forecastMod + + implicit none +! !ARGUMENTS: + integer :: n + integer :: kk + integer :: findex + character(len=*), intent(out) :: filename + character(len=*), intent(in) :: nldas20dir + integer, intent(in) :: yr,mo,da,doy,hr +! +! !DESCRIPTION: +! This subroutine assembles GES DISC NLDAS-2 netCDF-4 "B" filenames +! for 1 hour file intervals. +! +! The arguments are: +! \begin{description} +! \item[nldas20dir] +! Name of the NLDAS-2 directory +! \item[yr] +! year +! \item[mo] +! month +! \item[da] +! day of month +! \item[doy] +! Julian day of year (needed for subdirectory structure) +! \item[hr] +! hour of day +! \item[filename] +! name of the timestamped GES DISC NLDAS-2 netCDF-4 file +! \end{description} +! +!EOP + character*4 :: fyr + character*3 :: fdoy + character*2 :: fmo, fda, fhr + integer :: doy2 + +!=== end variable definition ============================================= + + if (LIS_rc%forecastMode.eq.0) then !hindcast run + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fdoy,fmt="(i3.3)") doy + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr + +!=== Assemble GES DISC NLDAS-2 netCDF-4 FORB filename: + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" + + else !forecast mode + doy2 = doy +! IF Forecast Year is a leap years, for doy: + if ((mod(LIS_rc%yr,4).eq.0.and.mod(LIS_rc%yr,100).ne.0) & + .or.(mod(LIS_rc%yr,400).eq.0)) then + if (doy.gt.59) then ! Make sure to remove extra day + doy2 = doy - 1 + endif + endif + +! Sample yr, mo, da + call LIS_sample_forecastDate(n,kk,findex,yr,mo,da) + +! Account for member year - leap years for doy: + if ((mod(yr,4).eq.0.and.mod(yr,100).ne.0) & + .or.(mod(yr,400).eq.0)) then + if (doy.gt.59) then + doy2 = doy + 1 + endif + endif + + write(unit=fdoy,fmt="(i3.3)") doy2 + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr + +!=== Assemble GES DISC NLDAS-2 netCDF-4 FORB filename: + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" + endif + + end subroutine netcdf4_nldas20fileb + diff --git a/lis/metforcing/nldas-2.0/get_nldas20.F90 b/lis/metforcing/nldas-2.0/get_nldas20.F90 new file mode 100644 index 000000000..4e7d52bb3 --- /dev/null +++ b/lis/metforcing/nldas-2.0/get_nldas20.F90 @@ -0,0 +1,272 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: get_nldas20 +! \label{get_nldas20} +! +! !REVISION HISTORY: +! 02 Feb 2004: Sujay Kumar; Initial Version in LIS +! 22 Aug 2007: Chuck Alonge; Updated for NLDAS2 Forcing +! 22 Jan 2012: K. Arsenault; Accommodate GESDISC, NCEP filename conventions +! 14 Mar 2014: David Mocko: Trim writing of filenames to log file +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine get_nldas20(n,findex) +! !USES: + use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_timeMgrMod, only : LIS_tick + use LIS_metforcingMod, only : LIS_forc + use LIS_logMod, only : LIS_logunit,LIS_endrun + use nldas20_forcingMod, only : nldas20_struc + use LIS_constantsMod, only : LIS_CONST_PATH_LEN + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: findex +! +! !DESCRIPTION: +! Opens, reads, and interpolates hourly, NLDAS-2 forcing (NARR based). +! At the beginning of a simulation, the code reads the most recent +! past data (nearest hourly interval), and the nearest future data. +! These two datasets are used to temporally interpolate the data to +! the current model timestep. The strategy for missing data is to +! go backwards up to 10 days to get forcing at the same time of day. +! +! The arguments are: +! \begin{description} +! \item[n] +! index of the nest +! \end{description} +! +! The routines invoked are: +! \begin{description} +! \item[LIS\_tick](\ref{LIS_tick}) \newline +! determines the NLDAS-2 data times +! \item[netcdf4\_nldas20filea](\ref{netcdf4_nldas20filea}) \newline +! Puts together appropriate timestamped GES DISC filename - a data +! \item[netcdf4\_nldas20fileb](\ref{netcdf4_nldas20fileb}) \newline +! Puts together appropriate timestamped GES DISC filename - b data +! \item[read\_nldas20a](\ref{read_nldas20a}) \newline +! Reads and Interpolates NLDAS-2 A data to LIS grid +! \item[read\_nldas20b](\ref{read_nldas20b}) \newline +! Reads and Interpolates NLDAS-2 B data to LIS grid +! \end{description} +! +!EOP + integer :: c,f,ferrora,ferrorb,ferror,try + integer :: order + integer :: readbfile + real*8 :: time1,time2,timenow + real*8 :: dtime1, dtime2 + integer :: yr1,mo1,da1,hr1,mn1,ss1,doy1 + integer :: yr2,mo2,da2,hr2,mn2,ss2,doy2 + character(len=LIS_CONST_PATH_LEN) :: name_a,name_b + real :: gmt1,gmt2,ts1,ts2 + integer :: movetime ! 1=move time 2 data into time 1 + integer :: kk ! Forecast member index + +!=== End Variable Definition =========================================== + try = -999 + +!=== Check to see if b-file needs to be opened + readbfile = 0 + if ((nldas20_struc(n)%model_level_data.gt.0).or. & + (nldas20_struc(n)%model_dswrf_data.gt.0).or. & + (nldas20_struc(n)%model_level_press.gt.0).or. & + (nldas20_struc(n)%model_pcp_data.gt.0)) then + readbfile = 1 + endif + +!=== Assumption will be not to find or move any data + nldas20_struc(n)%findtime1 = 0 + nldas20_struc(n)%findtime2 = 0 + movetime = 0 + +!=== Determine Required NLDAS-2 Data Times (The previous hour and the future hour) + yr1 = LIS_rc%yr + mo1 = LIS_rc%mo + da1 = LIS_rc%da + hr1 = LIS_rc%hr + mn1 = LIS_rc%mn + ss1 = 0 + ts1 = 0 + call LIS_tick(timenow,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + + if (LIS_rc%ts.gt.3600) then + write(LIS_logunit,*) & + "[ERR] The model timestep is > forcing data timestep" + write(LIS_logunit,*) & + "[ERR] LIS does not support this mode currently" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + + if (mod(nint(LIS_rc%ts),3600).eq.0) then + if (timenow.ge.nldas20_struc(n)%nldas20time2) then + yr1 = LIS_rc%yr + mo1 = LIS_rc%mo + da1 = LIS_rc%da + hr1 = LIS_rc%hr + mn1 = 0 + ss1 = 0 + ts1 = -60*60 !previous hour + call LIS_tick(time1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + + yr2 = LIS_rc%yr + mo2 = LIS_rc%mo + da2 = LIS_rc%da + hr2 = LIS_rc%hr + mn2 = 0 + ss2 = 0 + ts2 = 0 !current hour + call LIS_tick(time2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) + movetime = 1 + nldas20_struc(n)%findtime2 = 1 + endif + else + if (timenow.ge.nldas20_struc(n)%nldas20time2) then + yr1 = LIS_rc%yr + mo1 = LIS_rc%mo + da1 = LIS_rc%da + hr1 = LIS_rc%hr + mn1 = 0 + ss1 = 0 + ts1 = 0 !current hour + call LIS_tick(time1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + + yr2 = LIS_rc%yr + mo2 = LIS_rc%mo + da2 = LIS_rc%da + hr2 = LIS_rc%hr + mn2 = 0 + ss2 = 0 + ts2 = 60*60 !next hour + call LIS_tick(time2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) + + movetime = 1 + nldas20_struc(n)%findtime2 = 1 + endif + endif + +! Beginning of the run + if ((LIS_rc%tscount(n).eq.1).or.(LIS_rc%rstflag(n).eq.1)) then + nldas20_struc(n)%findtime1 = 1 + nldas20_struc(n)%findtime2 = 1 + movetime = 0 + LIS_rc%rstflag(n) = 0 + endif + + if (movetime.eq.1) then + nldas20_struc(n)%nldas20time1 = nldas20_struc(n)%nldas20time2 + do f = 1,LIS_rc%met_nf(findex) + do c = 1,LIS_rc%ngrid(n) + nldas20_struc(n)%metdata1(:,f,c) = & + nldas20_struc(n)%metdata2(:,f,c) + enddo + enddo + endif !end of movetime=1 + +! The following looks back 10 days, at the same hour to fill data gaps. + if (nldas20_struc(n)%findtime1.eq.1) then + ferrora = 0 + ferrorb = 0 + ferror = 0 + try = 0 + ts1 = -60*60*24 + do + if (ferror.ne.0) exit + try = try + 1 +!- Obtaining NLDAS-2 File-A: + do kk = nldas20_struc(n)%st_iterid,nldas20_struc(n)%en_iterid + call netcdf4_nldas20filea(n,kk,findex,name_a, & + nldas20_struc(n)%nldas20foradir,yr1,mo1,da1,doy1,hr1) + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file1a.. ",trim(name_a) + order = 1 + call read_nldas20a(n,kk,findex,order,mo1,name_a,ferrora) + enddo + + if (readbfile.gt.0) then + do kk = nldas20_struc(n)%st_iterid, nldas20_struc(n)%en_iterid + call netcdf4_nldas20fileb(n,kk,findex,name_b, & + nldas20_struc(n)%nldas20forbdir,yr1,mo1,da1,doy1,hr1) + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file1b.. ",trim(name_b) + call read_nldas20b(n,kk,findex,order,name_b,ferrorb) + enddo + else + ferrorb = 1 + endif + + ferror = ferrora + ferrorb + if (ferror.ge.1) nldas20_struc(n)%nldas20time1 = time1 + call LIS_tick(dtime1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + if (try.gt.11) then + write(LIS_logunit,*) & + "[ERR} NLDAS-2 data gap exceeds 10 days on file 1" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + enddo +!=== end of data search + endif !end of LIS_rc%findtime=1 + + if (nldas20_struc(n)%findtime2.eq.1) then +! The following looks back 10 days, at the same hour to fill data gaps. + ferrora = 0 + ferrorb = 0 + ferror = 0 + try = 0 + ts2 = -60*60*24 + do + if (ferror.ne.0) exit + try = try+1 + + !- Obtaining NLDAS-2 File-A: + do kk = nldas20_struc(n)%st_iterid,nldas20_struc(n)%en_iterid + call netcdf4_nldas20filea(n,kk,findex,name_a, & + nldas20_struc(n)%nldas20foradir,yr2,mo2,da2,doy2,hr2) + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file2a.. ",trim(name_a) + order = 2 + call read_nldas20a(n,kk,findex,order,mo2,name_a,ferrora) + enddo + + if (readbfile.gt.0) then + do kk = nldas20_struc(n)%st_iterid, nldas20_struc(n)%en_iterid + call netcdf4_nldas20fileb(n,kk,findex,name_b, & + nldas20_struc(n)%nldas20forbdir,yr2,mo2,da2,doy2,hr2) + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file2b.. ",trim(name_b) + call read_nldas20b(n,kk,findex,order,name_b,ferrorb) + enddo + else + ferrorb = 1 + endif + + ferror = ferrora + ferrorb + if (ferror.ge.1) then + nldas20_struc(n)%nldas20time2 = time2 + endif + call LIS_tick(dtime2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) + if (try.gt.11) then + write(LIS_logunit,*) & + "[ERR} NLDAS-2 data gap exceeds 10 days on file 2" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + enddo +!=== end of data search + endif ! end of findtime2=1 + + end subroutine get_nldas20 + diff --git a/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 b/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 new file mode 100644 index 000000000..23b190726 --- /dev/null +++ b/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 @@ -0,0 +1,120 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: nldas20_ec_removal +! \label{nldas20_ec_removal} +! +! !REVISION HISTORY: +! 20 Oct 2006: Kristi Arsenault; Adapted elevation correction code +! to remove such a correction from NLDAS2 fields +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine nldas20_ec_removal(nest,point,force_tmp,force_hum, & + force_lwd,force_prs) +! !USES: + use LIS_coreMod, only : LIS_rc + use nldas20_forcingMod, only : nldas20_struc + + implicit none +! !ARGUMENTS: + integer, intent(in) :: nest + integer, intent(in) :: point + real, intent(inout) :: force_tmp,force_hum + real, intent(inout) :: force_lwd,force_prs +! +! !DESCRIPTION: +! Removes Temperature, Pressure, Humidity and Longwave Radiation +! forcing correction. +! +! The corrections are based on the lapse-rate and hypsometric adjustments +! to these variables described in Cosgrove et. al (2003). +! +! Cosgrove, B.A. et.al, Real-time and retrospective forcing in the +! North American Land Data Assimilation (NLDAS2) project, Journal of +! Geophysical Research, 108(D22), 8842, DOI: 10.1029/2002JD003118, 2003. +! +! The arguments are: +! \begin{description} +! \item [nest] +! index of the domain or nest. +! \item [point] +! index of the grid point +! \item [force\_tmp] +! temperature value for the grid point +! \item [force\_hum] +! specific humidity for the grid point +! \item [force\_lwd] +! downward longwave radiation for the grid point +! \item [force\_prs] +! surface pressure for the grid point +! \end{description} +! +!EOP + real :: orig_tmp, orig_hum + real :: orig_lwd, orig_prs + real :: elevdiff + real :: mee, mfe, ee, fe, ratio + real :: esat,qsat,rh_corr,fesat,fqsat,femiss,emiss + real :: tbar + integer, parameter :: bb = 2016 + real, parameter :: grav = 9.81 + real, parameter :: rdry = 287. + real, parameter :: lapse = -0.0065 + +! ---------------------------------------------------------------- + + elevdiff = nldas20_struc(nest)%orig_ediff(point) + +! -- Apply elevation correction to temperature: + orig_tmp = force_tmp - (lapse*elevdiff) + tbar = (orig_tmp + force_tmp) / 2.0 + +! -- Apply elevation correction to surface pressure: + orig_prs = force_prs * (exp((grav*elevdiff)/(rdry*tbar))) + +! -- Apply elevation correction to humidity: + if (force_hum.eq.0) force_hum = 1e-08 + + esat = 611.2*(exp((17.67*(orig_tmp-273.15)) / & + ((orig_tmp-273.15)+243.5))) + qsat = (0.622*esat) / (orig_prs-(0.378*esat)) + fesat = 611.2*(exp((17.67*(force_tmp-273.15)) / & + ((force_tmp-273.15)+243.5))) + fqsat = (0.622*fesat) / (force_prs-(0.378*fesat)) + rh_corr = (force_hum / fqsat) * 100.0 + orig_hum = (rh_corr * qsat) / 100.0 + +! -- Apply elevation correction to downward LW radiation: + ee = (orig_hum * orig_prs) / 0.622 + fe = (force_hum * force_prs) / 0.622 + mee = ee / 100.0 + mfe = fe / 100.0 + +!---------------------------------------------------------------------- +! Correct for negative vapor pressure at very low temperatures at +! high latitudes +!---------------------------------------------------------------------- + if (mee.le.0) mee = 1e-08 + if (mfe.le.0) mfe = 1e-08 + + emiss = 1.08 * (1.0-exp(-mee**(orig_tmp/bb))) + femiss = 1.08 * (1.0-exp(-mfe**(force_tmp/bb))) + ratio = (femiss*(force_tmp**4)) / (emiss*(orig_tmp**4)) + orig_lwd = force_lwd / ratio + +!-- Reassign uncorrected fields to LIS forcing fields:: + force_tmp = orig_tmp + force_hum = orig_hum + force_lwd = orig_lwd + force_prs = orig_prs + + end subroutine nldas20_ec_removal + diff --git a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 new file mode 100644 index 000000000..6e0863a93 --- /dev/null +++ b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 @@ -0,0 +1,338 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + module nldas20_forcingMod +!BOP +! !MODULE: nldas20_forcingMod +! +! !REVISION HISTORY: +! 02 Feb 2004: Sujay Kumar; Initial Specification +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data +! 14 Mar 2014: David Mocko: Added CAPE and PET forcing from NLDAS-2 +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !USES: + use LIS_constantsMod, only : LIS_CONST_PATH_LEN + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: init_NLDAS20 !defines the native resolution of the input data +!----------------------------------------------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------------------------------------------- + public :: nldas20_struc +! +! !DESCRIPTION: +! This module contains variables and data structures that are used +! for the implementation of the forcing data used in the North American +! Land Data Assimilation System Phase 2. The variables are produced +! at 0.125 degree spatial resolution, and at hourly intervals. +! For more details please view the forcing files manual available +! at the following URL: +! https://ldas.gsfc.nasa.gov/nldas/v2/forcing +! +! The implemenatation in LIS has the derived data type {\tt nldas20\_struc} +! that includes the variables that specify the runtime options, and the +! weights and neighbor information to be used for spatial interpolation. +! They are described below: +! \begin{description} +! \item[ncold] +! Number of columns (along the east west dimension) for the input data +! \item[nrold] +! Number of rows (along the north south dimension) for the input data +! \item[nldas20time1] +! The nearest, previous hourly instance of the incoming +! data (as a real time). +! \item[nldas20time2] +! The nearest, next hourly instance of the incoming +! data (as a real time). +! \item[nldas20foradir] +! Directory containing the FORA netCDF-4 input data +! \item[nldas20foradir] +! Directory containing the FORB netCDF-4 input data +! \item[mi] +! Number of points in the input grid +! \item[n111,n121,n211,n221] +! Arrays containing the neighbor information of the input grid +! for each grid point in LIS, for bilinear interpolation. +! \item[w111,w121,w211,w221] +! Arrays containing the weights of the input grid +! for each grid point in LIS, for bilinear interpolation. +! \item[n122,n122,n212,n222] +! Arrays containing the neighbor information of the input grid +! for each grid point in LIS, for conservative interpolation. +! \item[w112,w122,w212,w222] +! Arrays containing the weights of the input grid +! for each grid point in LIS, for conservative interpolation. +! \item[n113] +! Arrays containing the neighbor information of the input grid +! for each grid point in LIS, for nearest neighbor interpolation. +! \item[findtime1, findtime2] +! boolean flags to indicate which time is to be read for +! temporal interpolation. +! \end{description} +! +!EOP + type, public :: nldas20_type_dec + real :: ts + integer :: ncold, nrold ! AWIPS 212 dimensions + character(len=LIS_CONST_PATH_LEN) :: nldas20foradir,nldas20forbdir + real*8 :: nldas20time1,nldas20time2 + integer :: model_level_data + integer :: model_level_press + integer :: model_pcp_data + integer :: model_dswrf_data + + real, allocatable :: orig_ediff(:) + real :: gridDesc(50) + integer :: mi + integer, allocatable :: n111(:) + integer, allocatable :: n121(:) + integer, allocatable :: n211(:) + integer, allocatable :: n221(:) + real, allocatable :: w111(:),w121(:) + real, allocatable :: w211(:),w221(:) + integer, allocatable :: n112(:,:) + integer, allocatable :: n122(:,:) + integer, allocatable :: n212(:,:) + integer, allocatable :: n222(:,:) + real, allocatable :: w112(:,:),w122(:,:) + real, allocatable :: w212(:,:),w222(:,:) + integer, allocatable :: n113(:) + + integer :: findtime1, findtime2 + integer :: nIter, st_iterid,en_iterid ! Forecast parameters + + real, allocatable :: metdata1(:,:,:) + real, allocatable :: metdata2(:,:,:) + + end type nldas20_type_dec + + type(nldas20_type_dec), allocatable :: nldas20_struc(:) + + contains +!BOP +! +! !ROUTINE: init_NLDAS20 +! \label{init_NLDAS20} +! +! !INTERFACE: + subroutine init_NLDAS20(findex) +! !USES: + use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_timeMgrMod, only : LIS_update_timestep + use LIS_logMod, only : LIS_logunit,LIS_endrun + use map_utils, only : proj_latlon + use LIS_spatialDownscalingMod, only : LIS_init_pcpclimo_native + use LIS_forecastMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: findex +! +! !DESCRIPTION: +! Defines the native resolution of the input forcing for NLDAS-2 +! data. The grid description arrays are based on the netCDF-4 +! data and followed in the LIS interpolation schemes +! (see Section~\ref{interp}). +! +! The routines invoked are: +! \begin{description} +! \item[readcrd\_nldas20](\ref{readcrd_nldas20}) \newline +! reads the runtime options specified for NLDAS-2 data +! \item[bilinear\_interp\_input](\ref{bilinear_interp_input}) \newline +! computes the neighbor, weights for bilinear interpolation +! \item[conserv\_interp\_input](\ref{conserv_interp_input}) \newline +! computes the neighbor, weights for conservative interpolation +! \item[read\_nldas20\_elev](\ref{read_nldas20_elev}) \newline +! reads the native elevation of the NLDAS-2 data to be used +! for topographic adjustments to the forcing +! \end{description} +! +!EOP + integer :: n + + allocate(nldas20_struc(LIS_rc%nnest)) + call readcrd_nldas20() + + do n = 1,LIS_rc%nnest + nldas20_struc(n)%ts = 3600 + call LIS_update_timestep(LIS_rc,n,nldas20_struc(n)%ts) + enddo + + LIS_rc%met_nf(findex) = 13 + +! Set NLDAS-2 grid dimensions and extent information: + nldas20_struc(:)%ncold = 464 + nldas20_struc(:)%nrold = 224 + + do n = 1,LIS_rc%nnest + +! Forecast mode: + if (LIS_rc%forecastMode.eq.1) then + if (mod(LIS_rc%nensem(n), & + LIS_forecast_struc(1)%niterations).ne.0) then + write(LIS_logunit,*) & + "[ERR] The number of ensembles must be a multiple" + write(LIS_logunit,*) & + "[ERR] of the number of iterations" + write(LIS_logunit,*) & + "[ERR] nensem = ",LIS_rc%nensem(n) + write(LIS_logunit,*) & + "[ERR] niter = ",LIS_forecast_struc(1)%niterations + call LIS_endrun() + endif + + allocate(nldas20_struc(n)%metdata1( & + LIS_forecast_struc(1)%niterations, & + LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) + allocate(nldas20_struc(n)%metdata2( & + LIS_forecast_struc(1)%niterations,& + LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) + + nldas20_struc(n)%st_iterid = LIS_forecast_struc(1)%st_iterId + nldas20_struc(n)%en_iterId = LIS_forecast_struc(1)%niterations + nldas20_struc(n)%nIter = LIS_forecast_struc(1)%niterations + +! Regular retrospective or non-forecast mode: + else + allocate(nldas20_struc(n)%metdata1(1,LIS_rc%met_nf(findex),& + LIS_rc%ngrid(n))) + allocate(nldas20_struc(n)%metdata2(1,LIS_rc%met_nf(findex),& + LIS_rc%ngrid(n))) + + nldas20_struc(n)%st_iterid = 1 + nldas20_struc(n)%en_iterId = 1 + nldas20_struc(n)%nIter = 1 + endif + + nldas20_struc(n)%metdata1 = 0 + nldas20_struc(n)%metdata2 = 0 + nldas20_struc(n)%gridDesc = 0 + nldas20_struc(n)%findtime1 = 0 + nldas20_struc(n)%findtime2 = 0 + nldas20_struc(n)%gridDesc(1) = 0 + nldas20_struc(n)%gridDesc(2) = nldas20_struc(n)%ncold + nldas20_struc(n)%gridDesc(3) = nldas20_struc(n)%nrold + nldas20_struc(n)%gridDesc(4) = 25.0625 + nldas20_struc(n)%gridDesc(5) = -124.9375 + nldas20_struc(n)%gridDesc(6) = 128 + nldas20_struc(n)%gridDesc(7) = 52.9375 + nldas20_struc(n)%gridDesc(8) = -67.0625 + nldas20_struc(n)%gridDesc(9) = 0.125 + nldas20_struc(n)%gridDesc(10) = 0.125 + nldas20_struc(n)%gridDesc(20) = 64 + +! Check for grid and interp option selected: + if ((nldas20_struc(n)%gridDesc(9).eq.LIS_rc%gridDesc(n,9)).and.& + (nldas20_struc(n)%gridDesc(10).eq.LIS_rc%gridDesc(n,10)).and.& + (LIS_rc%gridDesc(n,1).eq.proj_latlon).and. & + (LIS_rc%met_interp(findex).ne."neighbor")) then + write(LIS_logunit,*) & + "[ERR] The NLDAS grid was selected for the LIS run domain;" + write(LIS_logunit,*) & + "[ERR] however, 'bilinear', 'budget-bilinear', or some" + write(LIS_logunit,*) & + "[ERR] other unknown option was selected to spatially" + write(LIS_logunit,*) & + "[ERR] downscale the grid, which will cause errors" + write(LIS_logunit,*) & + "[ERR] during runtime. Please select 'neighbor'." + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + + nldas20_struc(n)%mi = nldas20_struc(n)%ncold*nldas20_struc(n)%nrold + +! Setting up weights for spatial interpolation: + select case(LIS_rc%met_interp(findex)) + + case ("bilinear") + allocate(nldas20_struc(n)%n111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + + call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221) + + case ("budget-bilinear") + allocate(nldas20_struc(n)%n111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + + call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221) + + allocate(nldas20_struc(n)%n112(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%n122(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%n212(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%n222(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w112(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w122(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w212(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w222(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + + call conserv_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n112,nldas20_struc(n)%n122, & + nldas20_struc(n)%n212,nldas20_struc(n)%n222, & + nldas20_struc(n)%w112,nldas20_struc(n)%w122, & + nldas20_struc(n)%w212,nldas20_struc(n)%w222) + + case ("neighbor") + allocate(nldas20_struc(n)%n113(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + call neighbor_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n113) + + case default + write(LIS_logunit,*) & + "[ERR] Interpolation option not specified for NLDAS-2" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + end select + +! Read in elevation difference and NLDAS2 elevation maps: + if (LIS_rc%met_ecor(findex).ne."none") then + allocate(nldas20_struc(n)%orig_ediff( & + nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + call read_orig_nldas20_elevdiff(n) + call read_nldas20_elev(n,findex) + endif + +! Set up precipitation climate downscaling: + if (LIS_rc%pcp_downscale(findex).ne.0) then + call LIS_init_pcpclimo_native(n,findex, & + nint(nldas20_struc(n)%gridDesc(2)), & + nint(nldas20_struc(n)%gridDesc(3))) + endif + enddo + + end subroutine init_NLDAS20 + + end module nldas20_forcingMod + diff --git a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 new file mode 100644 index 000000000..3f36479e2 --- /dev/null +++ b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 @@ -0,0 +1,97 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! !ROUTINE: read_nldas20_elev +! \label{read_nldas20_elev} +! +! !REVISION HISTORY: +! 17 Dec 2004; Sujay Kumar; Initial Specificaton +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS2 data +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine read_nldas20_elev(n,findex) +! !USES: + use LIS_coreMod + use LIS_metforcingMod + use LIS_logMod + use nldas20_forcingMod + use LIS_fileIOMod +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + use netcdf +#endif + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: findex +! +! !DESCRIPTION: +! +! Opens, reads, and interpolates NLDAS2 model elevation to the LIS +! grid. The data will be used to perform any topographical +! adjustments to the forcing. +! +! The arguments are: +! \begin{description} +! \item[n] +! index of the nest +! \end{description} +! +! The routines invoked are: +! \begin{description} +! \item[ij\_to\_latlon](\ref{ij_to_latlon}) \newline +! computes the lat lon values in LIS grid projection +! \end{description} +! +!EOP + integer :: i, err + logical :: file_exists + integer :: nid,elevId + integer :: c,r + real :: elev(LIS_rc%gnc(n),LIS_rc%gnr(n)) + real :: elev_subset(LIS_rc%lnc(n),LIS_rc%lnr(n)) + +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + inquire(file=LIS_rc%paramfile(n),exist=file_exists) + if (file_exists) then + write(LIS_logunit,*) & + "[INFO] Reading NLDAS-2 elevation data ... " + + call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & + mode=NF90_NOWRITE,ncid=nid), & + "nf90_open failed in read_nldas20_elev") + call LIS_verify(nf90_inq_varid(nid,"ELEV_NLDAS2",elevId), & + "nf90_inq_varid failed in read_nldas20_elev") + call LIS_verify(nf90_get_var(nid,elevId,elev), & + "nf90_get_var failed in read_nldas20_elev") + call LIS_verify(nf90_close(nid)) + + elev_subset(:,:) = elev(LIS_ews_halo_ind(n,LIS_localPet+1): & + LIS_ewe_halo_ind(n,LIS_localPet+1), & + LIS_nss_halo_ind(n,LIS_localPet+1): & + LIS_nse_halo_ind(n,LIS_localPet+1)) + + do r = 1,LIS_rc%lnr(n) + do c = 1,LIS_rc%lnc(n) + if (LIS_domain(n)%gindex(c,r).ne.-1) then + LIS_forc(n,findex)%modelelev(LIS_domain(n)%gindex(c,r)) = elev_subset(c,r) + endif + enddo + enddo + endif + + write(LIS_logunit,*) & + "Finished reading original NLDAS-2 elevation data" +#endif + + end subroutine read_nldas20_elev + diff --git a/lis/metforcing/nldas-2.0/read_nldas20a.F90 b/lis/metforcing/nldas-2.0/read_nldas20a.F90 new file mode 100644 index 000000000..3ef0693f7 --- /dev/null +++ b/lis/metforcing/nldas-2.0/read_nldas20a.F90 @@ -0,0 +1,379 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! !ROUTINE: read_nldas20a +! \label{read_nldas20a} +! +! !REVISION HISTORY: +! 11 Apr 2000: Brian Cosgrove; changed code to use Forcing Mask (With +! inland water filled in). Deleted unused variables. +! 27 Apr 2000: Brian Cosgrove; changed code to use the original +! mask again since that is the +! mask which NCEP has already applied to the forcing data +! by the time NASA gets it......not possible to use the +! expanded NASA forcing mask +! 1 May 2000: Brian Cosgrove; changed code so that if parameter 11 (sw) +! is not found in hourly ncep data, it will just use +! edas-based shortwave from the hourly ncep files +! 20 Jun 2000: Brian Cosgrove; changed code so that it uses LDAS%UDEF and +! not a hard-wired undefined value of -999.9 and -999.0 +! 18 Aug 2000: Brian Cosgrove; changed code so that FMASK and not MASK +! is used when ungribbing. NCEP data already has a mask applied +! to it and so may not be able to supply forcing data to +! all LDAS land forcing points. In areas where LDAS +! forcing mask states that land exists, but where NCEP forcing +! data is non-existent, assign undefined value to forcing data. +! 22 Aug 2000: Brian Cosgrove; Altered code for US/Mexico/Canada Mask +! 05 Sep 2001: Brian Cosgrove; Removed dirnom and infile variables, changed +! call to ungribncep to match removal. Added code to make use +! of precip weighting mask +! 02 Feb 2004: Sujay Kumar; Initial Specification in LIS +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data +! 25 Jan 2012: Sujay Kumar; Switched to the use of grib-api library +! 14 Mar 2014: David Mocko: Added CAPE and PET forcing from NLDAS-2 +! 16 Oct 2017: Bailing Li: Modified interp_nldas2 to read climatology ratios +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) +! !USES: + use LIS_coreMod + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_warning + use LIS_metforcingMod, only : LIS_forc + use nldas20_forcingMod, only : nldas20_struc +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + use netcdf +#endif + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: kk ! Forecast member index + integer, intent(in) :: findex ! Forcing index + integer, intent(in) :: order + integer, intent(out) :: month + character(len=*), intent(in) :: name + integer, intent(out) :: ferror +! +! !DESCRIPTION: +! For the given time, reads values from NLDAS-2 netCDF-4 FORA data, +! transforms into 11 variables, and interpolates to the LIS domain. +! +! The arguments are: +! \begin{description} +! \item[n] +! index of the nest +! \item[kk] +! forecast member index +! \item[findex] +! forcing index +! \item[order] +! flag indicating which data to be read (order=1, read the previous +! hourly instance, order=2, read the next hourly instance) +! \item[month] +! current month +! \item[name] +! name of the hourly NLDAS-2 forecast file +! \item[ferror] +! flag to indicate success of the call (=1 indicates success) +! \end{description} +! +! The routines invoked are: +! \begin{description} +! \item[interp\_nldas20](\ref{interp_nldas20}) \newline +! spatially interpolates a NLDAS-2 variable +! \end{description} +! +!EOP + integer :: iv,ftn + integer :: nldas20,paramid + integer :: k,t,c,r,iret,rc + real, parameter :: missingValue = -9999.0 + integer, parameter :: nvars = 11 + logical :: pcp_flag + logical :: file_exists + character(len=20) :: input_varname(nvars) + logical*1, allocatable :: lb(:) + real, allocatable :: f(:) + real, allocatable :: nldas20_forcing(:,:) + real :: varfield(LIS_rc%lnc(n),LIS_rc%lnr(n)) + real :: dummy(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) + + ferror = 1 + iv = 0 + + input_varname(1) = "Tair" + input_varname(2) = "Qair" + input_varname(3) = "SWdown" + input_varname(4) = "LWdown" + input_varname(5) = "Wind_E" + input_varname(6) = "Wind_N" + input_varname(7) = "PSurf" + input_varname(8) = "Rainf" + input_varname(9) = "CRainf_frac" + input_varname(10) = "PotEvap" + input_varname(11) = "CAPE" + +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + nldas20 = (nldas20_struc(n)%ncold*nldas20_struc(n)%nrold) + + allocate(nldas20_forcing(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold,nvars)) + + varfield = 0 + ferror = 1 + + inquire(file=name,exist=file_exists) + if (file_exists) then + iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) + if (iret.ne.0) then + write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) + ferror = 0 + return + endif + + allocate(lb(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + allocate(f(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + + do k = 1,nvars + iret = nf90_inq_varid(ftn,trim(input_varname(k)),paramid) + call LIS_verify(iret,trim(input_varname(k))// & + " field not found in the hourly file") + iret = nf90_get_var(ftn,paramid,dummy) + call LIS_verify(iret,"Error in nf90_get_var") + +! write(LIS_logunit,*) "[INFO] Read field: ",input_varname(k) + + f = LIS_rc%udef ! Initialize forcing + t = 0 + do r = 1,nldas20_struc(n)%nrold + do c = 1,nldas20_struc(n)%ncold + t = t + 1 + f(t) = dummy(c,r) + enddo + enddo + + lb = .false. + do t = 1,nldas20 + if (f(t).ne.missingValue) then + nldas20_forcing(t,k) = f(t) + lb(t) = .true. + else + nldas20_forcing(t,k) = LIS_rc%udef + endif + enddo + enddo + deallocate(f) + + iret = nf90_close(ftn) + + if (LIS_rc%met_ecor(findex).ne."none") then + do t = 1,nldas20 + if (lb(t)) then + call nldas20_ec_removal(n,t,nldas20_forcing(t,1), & + nldas20_forcing(t,2),nldas20_forcing(t,4), & + nldas20_forcing(t,7)) + endif + enddo + endif + + do iv = 1,nvars + pcp_flag = .false. + if ((iv.eq.8).or.(iv.eq.9)) pcp_flag = .true. + + call interp_nldas20(n,findex,month,pcp_flag,nldas20, & + nldas20_forcing(:,iv), & + lb,LIS_rc%gridDesc(n,:), & + LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) + + do r = 1,LIS_rc%lnr(n) + do c = 1,LIS_rc%lnc(n) + if (LIS_domain(n)%gindex(c,r).ne.-1) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,iv, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,iv, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + enddo + enddo + enddo + deallocate(lb) + else + write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) + ferror = 0 + endif + + deallocate(nldas20_forcing) +#endif + + end subroutine read_nldas20a + +!BOP +! !ROUTINE: interp_nldas20 +! \label{interp_nldas20} +! +! !INTERFACE: + subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & + input_data,input_bitmap,lis_gds,nc,nr,output_2d) +! !USES: + use LIS_coreMod, only : LIS_rc,LIS_domain + use nldas20_forcingMod, only : nldas20_struc + use LIS_spatialDownscalingMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: findex + integer, intent(in) :: month + logical, intent(in) :: pcp_flag + integer, intent(in) :: input_size + real, intent(in) :: input_data(input_size) + logical*1, intent(in) :: input_bitmap(input_size) + real, intent(in) :: lis_gds(50) + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: output_2d(nc,nr) +! +! !DESCRIPTION: +! This subroutine interpolates a given NLDAS-2 field to the LIS grid. +! The arguments are: +! \begin{description} +! \item[n] +! index of the nest +! \item[findex] +! forcing index +! \item[month] +! current month +! \item[pcp_flag] +! flag indicating if it is a precip field +! \item[input\_size] +! number of elements in the input grid +! \item[input\_bitmap] +! input bitmap +! \item[lis\_gds] +! array description of the LIS grid +! \item[nc] +! number of columns (in the east-west dimension) in the LIS grid +! \item[nr] +! number of rows (in the north-south dimension) in the LIS grid +! \item[output\_2d] +! output interpolated field +! \end{description} +! +! The routines invoked are: +! \begin{description} +! \item[bilinear\_interp](\ref{bilinear_interp}) \newline +! spatially interpolate the forcing data using bilinear interpolation +! \item[conserv\_interp](\ref{conserv_interp}) \newline +! spatially interpolate the forcing data using conservative interpolation +! \item[neighbor\_interp](\ref{neighbor_interp}) \newline +! spatially interpolate the forcing data using nearest neighbor interpolation +! \end{description} +! +!EOP + integer :: iret + integer :: mo + integer :: count1,i,j + real, dimension(nc*nr) :: output_data + logical*1 :: output_bitmap(nc*nr) + +!=== End variable declarations + + mo = nc*nr +!----------------------------------------------------------------------- +! Initialize output bitmap. +!----------------------------------------------------------------------- + output_bitmap = .true. + +!----------------------------------------------------------------------- +! Apply downscaling +!----------------------------------------------------------------------- + +!Bailing Li +! if LIS_rc%pcp_downscale(findex).eq.1: spatial downscaling and scaling factors are calculated in LIS +! if LIS_rc%pcp_downscale(findex).eq.2: spatial downscaling and bias-correction using ratios of two +! PCP climatologies which are calculated in LDT and stored in lis input file + + if (pcp_flag) then + if (LIS_rc%pcp_downscale(findex).eq.1) then +!input_data becomes the ratio field. + call LIS_generatePcpClimoRatioField(n,findex,"NLDAS2", & + month,input_size,input_data,input_bitmap) + elseif (pcp_flag.and.(LIS_rc%pcp_downscale(findex).eq.2)) then + call LIS_readPcpClimoRatioField(n,findex,month) + endif + endif + +!----------------------------------------------------------------------- +! Interpolate to LIS grid +!----------------------------------------------------------------------- + select case(LIS_rc%met_interp(findex)) + + case("bilinear") + call bilinear_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221, & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + LIS_rc%udef,iret) + + case("budget-bilinear") + if (pcp_flag) then + call conserv_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%w112,nldas20_struc(n)%w122, & + nldas20_struc(n)%w212,nldas20_struc(n)%w222, & + nldas20_struc(n)%n112,nldas20_struc(n)%n122, & + nldas20_struc(n)%n212,nldas20_struc(n)%n222, & + LIS_rc%udef,iret) + + else + call bilinear_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221, & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + LIS_rc%udef,iret) + endif + + case("neighbor") + call neighbor_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%n113,LIS_rc%udef,iret) + + end select + + if (pcp_flag.and.(LIS_rc%pcp_downscale(findex).ne.0)) then + call LIS_pcpClimoDownscaling(n,findex,month,nc*nr, & + output_data,output_bitmap) + endif + +!----------------------------------------------------------------------- +! convert the interpolated data to 2d. +!----------------------------------------------------------------------- + count1 = 0 + do j = 1,nr + do i = 1,nc + output_2d(i,j) = output_data(i+count1) + enddo + count1 = count1 + nc + enddo + + end subroutine interp_nldas20 + diff --git a/lis/metforcing/nldas-2.0/read_nldas20b.F90 b/lis/metforcing/nldas-2.0/read_nldas20b.F90 new file mode 100644 index 000000000..b1c52ef6d --- /dev/null +++ b/lis/metforcing/nldas-2.0/read_nldas20b.F90 @@ -0,0 +1,331 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! !ROUTINE: read_nldas20b +! \label{read_nldas20b} +! +! !REVISION HISTORY: +! 11 Apr 2000: Brian Cosgrove; changed code to use Forcing Mask (With +! inland water filled in). Deleted unused variables. +! 27 Apr 2000: Brian Cosgrove; changed code to use the original +! mask again since that is the +! mask which NCEP has already applied to the forcing data +! by the time NASA gets it......not possible to use the +! expanded NASA forcing mask +! 1 May 2000: Brian Cosgrove; changed code so that if parameter 11 (sw) +! is not found in hourly ncep data, it will just use +! edas-based shortwave from the hourly ncep files +! 20 Jun 2000: Brian Cosgrove; changed code so that it uses LDAS%UDEF and +! not a hard-wired undefined value of -999.9 and -999.0 +! 18 Aug 2000: Brian Cosgrove; changed code so that FMASK and not MASK +! is used when ungribbing. NCEP data already has a mask applied +! to it and so may not be able to supply forcing data to +! all LDAS land forcing points. In areas where LDAS +! forcing mask states that land exists, but where NCEP forcing +! data is non-existent, assign undefined value to forcing data. +! 22 Aug 2000: Brian Cosgrove; Altered code for US/Mexico/Canada Mask +! 05 Sep 2001: Brian Cosgrove; Removed dirnom and infile variables, changed +! call to ungribncep to match removal. Added code to make use +! of precip weighting mask +! 02 Feb 2004: Sujay Kumar; Initial Specification in LIS +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data +! 25 Jan 2012: Sujay Kumar; Switched to the use of grib-api library +! 14 Mar 2014: David Mocko: Fixed the use of Forcing "B" file data +! of NARR meteorology, radiation, precip, +! and/or forcing height fields +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine read_nldas20b(n,kk,findex,order,name,ferror) +! !USES: + use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_warning + use LIS_metforcingMod, only : LIS_forc + use nldas20_forcingMod, only : nldas20_struc +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + use netcdf +#endif + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: kk ! Forecast member index + integer, intent(in) :: findex ! Forcing index + integer, intent(in) :: order + character(len=*), intent(in) :: name + integer, intent(out) :: ferror +! +! !DESCRIPTION: +! For the given time, reads values from NLDAS-2 netCDF-4 FORB data, +! transforms into 10 variables, and interpolates to the LIS domain. +! +! The arguments are: +! \begin{description} +! \item[n] +! index of the nest +! \item[kk] +! forecast member index +! \item[findex] +! forcing index +! \item[order] +! flag indicating which data to be read (order=1, read the previous +! hourly instance, order=2, read the next hourly instance) +! \item[name] +! name of the hourly NLDAS-2 forecast file +! \item[ferror] +! flag to indicate success of the call (=1 indicates success) +! \end{description} +! +! The routines invoked are: +! \begin{description} +! \item[interp\_nldas20](\ref{interp_nldas20}) \newline +! spatially interpolates a NLDAS-2 variable +! \end{description} +! +!EOP + integer :: iv,ftn + integer :: nldas20,paramid + integer :: k,t,c,r,iret,rc + real, parameter :: missingValue = -9999.0 + integer, parameter :: nvars = 10 + logical :: pcp_flag + logical :: file_exists + character(len=20) :: input_varname(nvars) + logical*1, allocatable :: lb(:) + real, allocatable :: f(:) + real, allocatable :: nldas20_forcing(:,:) + real :: varfield(LIS_rc%lnc(n),LIS_rc%lnr(n)) + real :: dummy(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) + + ferror = 1 + iv = 0 + + input_varname(1) = "SWdown" + input_varname(2) = "Rainf" + input_varname(3) = "CRainf" + input_varname(4) = "ACond" + input_varname(5) = "Tair" + input_varname(6) = "Qair" + input_varname(7) = "PSurf" + input_varname(8) = "Wind_E" + input_varname(9) = "Wind_N" + input_varname(10) = "PhiS" + +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + nldas20 = (nldas20_struc(n)%ncold*nldas20_struc(n)%nrold) + + allocate(nldas20_forcing(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold,nvars)) + + varfield = 0 + ferror = 1 + + inquire(file=name,exist=file_exists) + if (file_exists) then + iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) + if (iret.ne.0) then + write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) + ferror = 0 + return + endif + + allocate(lb(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + allocate(f(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + + do k = 1,nvars + iret = nf90_inq_varid(ftn,trim(input_varname(k)),paramid) + call LIS_verify(iret,trim(input_varname(k))// & + " field not found in the hourly file") + iret = nf90_get_var(ftn,paramid,dummy) + call LIS_verify(iret,"Error in nf90_get_var") + +! write(LIS_logunit,*) "[INFO] Read field: ",input_varname(k) + + f = LIS_rc%udef ! Initialize forcing + t = 0 + do r = 1,nldas20_struc(n)%nrold + do c = 1,nldas20_struc(n)%ncold + t = t + 1 + f(t) = dummy(c,r) + enddo + enddo + + lb = .false. + do t = 1,nldas20 + if (f(t).ne.missingValue) then + nldas20_forcing(t,k) = f(t) + lb(t) = .true. + else + nldas20_forcing(t,k) = LIS_rc%udef + endif + enddo + enddo + deallocate(f) + + iret = nf90_close(ftn) + + do iv = 1,nvars + pcp_flag = .false. + if ((iv.eq.2).or.(iv.eq.3)) pcp_flag = .true. + + call interp_nldas20(n,findex,LIS_rc%mo,pcp_flag,nldas20, & + nldas20_forcing(:,iv), & + lb,LIS_rc%gridDesc(n,:), & + LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) + + do r = 1,LIS_rc%lnr(n) + do c = 1,LIS_rc%lnc(n) + if (LIS_domain(n)%gindex(c,r).ne.-1) then + +! MODEL LEVEL TAIR CASE + if (iv.eq.5) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,1, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,1, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL LEVEL SPFH CASE + if (iv.eq.6) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,2, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,2, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! USE MODEL BASED DSWRF CASE + if (iv.eq.1) then + if (nldas20_struc(n)%model_dswrf_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,3, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,3, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL LEVEL USE AERODYNAMIC CONDUCTANCE + if (iv.eq.4) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,13, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,13, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL LEVEL UWIND CASE + if (iv.eq.8) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,5, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,5, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL LEVEL VWIND CASE + if (iv.eq.9) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,6, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,6, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL LEVEL PRESSURE CASE + if (iv.eq.7) then + if (nldas20_struc(n)%model_level_press.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,7, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,7, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL BASED PRECIP CASE + if (iv.eq.2) then + if (nldas20_struc(n)%model_pcp_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,8, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,8, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL BASED CONV. PRECIP CASE + if (iv.eq.3) then + if (nldas20_struc(n)%model_pcp_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,9, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,9, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + +! MODEL FORCING HEIGHT CASE + if (iv.eq.10) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,12, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,12, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + + endif + enddo + enddo + enddo + deallocate(lb) + else + write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) + ferror = 0 + endif + + deallocate(nldas20_forcing) +#endif + + end subroutine read_nldas20b + diff --git a/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 new file mode 100644 index 000000000..3a4532307 --- /dev/null +++ b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 @@ -0,0 +1,79 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! !ROUTINE: read_orig_nldas20_elevdiff +! \label{read_orig_nldas20_elevdiff} +! +! !REVISION HISTORY: +! 7 Nov 2012: Sujay Kumar - initial specification based on the NLDAS-1 +! implementation +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine read_orig_nldas20_elevdiff(n) +! !USES: + use LIS_coreMod + use nldas20_forcingMod, only : nldas20_struc + use LIS_logmod +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + use netcdf +#endif + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n +! +! !DESCRIPTION: +! Open and read in original NLDAS elevation difference file. +! +! The arguments are: +! \begin{description} +! \item [n] +! index of the domain or nest. +! \end{description} +! +!EOP + integer :: i, err + logical :: file_exists + integer :: nid,elevId + integer :: c,r + real :: elevdiff(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) + +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + + inquire(file=LIS_rc%paramfile(n),exist=file_exists) + + if (file_exists) then + write(LIS_logunit,*) & + "[INFO] Reading NLDAS-2 original elevation difference file ..." + + call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & + mode=NF90_NOWRITE,ncid=nid), & + "nf90_open failed in read_orig_nldas20_elevdiff") + call LIS_verify(nf90_inq_varid(nid,"ELEVDIFF_NLDAS2",elevId), & + "nf90_inq_varid failed in read_orig_nldas20_elevdiff") + call LIS_verify(nf90_get_var(nid,elevId,elevdiff), & + "nf90_get_var failed in read_orig_nldas20_elevdiff") + call LIS_verify(nf90_close(nid)) + + do r = 1,nldas20_struc(n)%nrold + do c = 1,nldas20_struc(n)%ncold + nldas20_struc(n)%orig_ediff(c+(r-1)*nldas20_struc(n)%ncold) = elevdiff(c,r) + enddo + enddo + endif + + write(LIS_logunit,*) "[INFO] Finished reading original NLDAS-2" + write(LIS_logunit,*) "[INFO] NLDAS2 elevation difference data.." +#endif + + end subroutine read_orig_nldas20_elevdiff + diff --git a/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 new file mode 100644 index 000000000..c665753fe --- /dev/null +++ b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 @@ -0,0 +1,121 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! +! !ROUTINE: readcrd_nldas20 +! \label{readcrd_nldas20} +! +! !REVISION HISTORY: +! 02Feb2004; Sujay Kumar, Initial Code +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS2 data +! 22 Jan 2012: K. Arsenault; Accommodate GES DISC, NCEP filename conventions +! 14 Mar 2014: David Mocko: Removed elevation file line in config file, +! as this data is now in the LDT input file. +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine readcrd_nldas20() +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc,LIS_config + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_endrun + use nldas20_forcingMod, only : nldas20_struc + + implicit none +! +! !DESCRIPTION: +! This routine reads the options specific to NLDAS-2 forcing from +! the LIS configuration file. +! +!EOP + integer :: n,rc + + do n = 1,LIS_rc%nnest + nldas20_struc(n)%model_level_data = 0 + nldas20_struc(n)%model_level_press = 0 + nldas20_struc(n)%model_pcp_data = 0 + nldas20_struc(n)%model_dswrf_data = 0 + enddo + + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 FORA forcing directory:",rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 FORA forcing directory: not defined") + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%nldas20foradir,rc=rc) + enddo + + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model level data:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_level_data,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model level data: is not defined") + enddo + + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model-based SWdown:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_dswrf_data,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model-based SWdown: not defined") + enddo + + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model-based precip:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_pcp_data,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model-based precip: not defined") + enddo + + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model-based pressure:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_level_press,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model-based pressure: not defined") + enddo + + write(unit=LIS_logunit,fmt=*) & + "[INFO] Using NLDAS-2.0 v020 netCDF-4 forcing" + + do n = 1,LIS_rc%nnest + write(unit=LIS_logunit,fmt=*) & + "[INFO] NLDAS-2.0 FORA forcing directory: ", & + trim(nldas20_struc(n)%nldas20foradir) + nldas20_struc(n)%ncold = 464 + nldas20_struc(n)%nrold = 224 + nldas20_struc(n)%nldas20time1 = 3000.0 + nldas20_struc(n)%nldas20time2 = 0.0 + + if ((nldas20_struc(n)%model_level_data.eq.1).or. & + (nldas20_struc(n)%model_dswrf_data.eq.1).or. & + (nldas20_struc(n)%model_pcp_data.eq.1).or. & + (nldas20_struc(n)%model_level_press.eq.1)) then + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 FORB forcing directory:",rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 FORB forcing directory: not defined") + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%nldas20forbdir,rc=rc) + write(unit=LIS_logunit,fmt=*) & + "[INFO] NLDAS-2.0 FORB forcing directory: ", & + trim(nldas20_struc(n)%nldas20forbdir) + endif + enddo + + end subroutine readcrd_nldas20 + diff --git a/lis/metforcing/nldas-2.0/reset_nldas20.F90 b/lis/metforcing/nldas-2.0/reset_nldas20.F90 new file mode 100644 index 000000000..a27369140 --- /dev/null +++ b/lis/metforcing/nldas-2.0/reset_nldas20.F90 @@ -0,0 +1,40 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! !MODULE: reset_nldas20 +! \label{reset_nldas20} +! +! !REVISION HISTORY: +! 25 Oct 2005; Sujay Kumar, Initial Code +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine reset_nldas20() +! !USES: + use LIS_coreMod, only : LIS_rc + use nldas20_forcingMod, only : nldas20_struc + + implicit none +! +! !DESCRIPTION: +! Routine to reset nldas2 forcing related memory allocations. +! +!EOP + integer :: n + integer :: findex + + do n = 1,LIS_rc%nnest + nldas20_struc(n)%nldas20time1 = 3000.0 + nldas20_struc(n)%nldas20time2 = 0.0 + enddo + + end subroutine reset_nldas20 + diff --git a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 new file mode 100644 index 000000000..e9f65642c --- /dev/null +++ b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 @@ -0,0 +1,485 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.5 +! +! Copyright (c) 2024 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! !ROUTINE: timeinterp_nldas20 +! \label{timeinterp_nldas20} +! +! !REVISION HISTORY: +! 02 Feb 2004: Sujay Kumar; Initial Specification +! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data +! 14 Mar 2014: David Mocko: Added CAPE and PET forcing from NLDAS-2 +! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! +! !INTERFACE: + subroutine timeinterp_nldas20(n,findex) +! !USES: + use ESMF + use LIS_FORC_AttributesMod + use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_constantsMod, only : LIS_CONST_SOLAR + use LIS_metforcingMod, only : LIS_forc,LIS_FORC_Base_State + use LIS_timeMgrMod, only : LIS_tick,LIS_time2date + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_endrun + use nldas20_forcingMod, only : nldas20_struc + use LIS_forecastMod, only : LIS_get_iteration_index + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: findex +! +! !DESCRIPTION: +! Temporally interpolates the forcing data to the current model +! timestep. Downward shortwave radiation is interpolated using +! a zenith-angled based approach. Precipitation fields are not +! temporally interpolated, as it is backward-accumulated in the +! forcing files. All other variables are linearly interpolated +! between the hourly blocks. +! +! The routines invoked are: +! \begin{description} +! \item[LIS\_time2date](\ref{LIS_time2date}) \newline +! converts the time to a date format +! \item[LIS\_tick](\ref{LIS_tick}) \newline +! advances or retracts time by the specified amount +! \item[zterp](\ref{zterp}) \newline +! zenith-angle based interpolation +! \end{description} +! +!EOP + integer :: zdoy + real :: zw1,zw2 + real :: czm,cze,czb + real :: wt1,wt2,swt1,swt2 + real :: gmt1,gmt2,tempbts + integer :: t,index1 + integer :: bdoy,byr,bmo,bda,bhr,bmn + real*8 :: btime,newtime1,newtime2 + real :: tempgmt1,tempgmt2 + integer :: tempbdoy,tempbyr,tempbmo,tempbda,tempbhr,tempbmn + integer :: tempbss + + integer :: status + type(ESMF_Field) :: tmpField,q2Field,uField,vField,swdField,lwdField + type(ESMF_Field) :: psurfField,pcpField,cpcpField,fhgtField,acondField + type(ESMF_Field) :: PETField,CAPEField + real, pointer :: tmp(:),q2(:),uwind(:),vwind(:) + real, pointer :: swd(:),lwd(:),psurf(:),pcp(:),cpcp(:) + real, pointer :: fheight(:),acond(:),pet(:),cape(:) + logical :: forcing_z,forcing_ch,forcing_pet,forcing_cape + integer :: mfactor,m,k,kk + +!________________________________________ + + btime = nldas20_struc(n)%nldas20time1 + call LIS_time2date(btime,bdoy,gmt1,byr,bmo,bda,bhr,bmn) + + tempbdoy = bdoy + tempgmt1 = gmt1 + tempbyr = byr + tempbmo = bmo + tempbda = bda + tempbhr = bhr + if (tempbhr.eq.24) tempbhr = 0 + tempbmn = bmn + tempbss = 0 + tempbts = 0 + call LIS_tick(newtime1,tempbdoy,tempgmt1,tempbyr,tempbmo,tempbda,& + tempbhr,tempbmn,tempbss,tempbts) + + btime = nldas20_struc(n)%nldas20time2 + call LIS_time2date(btime,bdoy,gmt2,byr,bmo,bda,bhr,bmn) + tempbdoy = bdoy + tempgmt2 = gmt2 + tempbyr = byr + tempbmo = bmo + tempbda = bda + tempbhr = bhr + if (tempbhr.eq.24) tempbhr = 0 + tempbmn = bmn + tempbss = 0 + tempbts = 0 + call LIS_tick(newtime2,tempbdoy,tempgmt2,tempbyr,tempbmo,tempbda,& + tempbhr,tempbmn,tempbss,tempbts) + +!=== Interpolate Data in time + wt1 = (nldas20_struc(n)%nldas20time2 - LIS_rc%time) / & + (nldas20_struc(n)%nldas20time2 - nldas20_struc(n)%nldas20time1) + wt2 = 1.0 - wt1 + swt1 = (newtime2 - LIS_rc%time) / (newtime2 - newtime1) + swt2 = 1.0 - swt1 + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Tair%varname(1),tmpField,rc=status) + call LIS_verify(status, & + "Error: Enable Tair in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Qair%varname(1),q2Field,rc=status) + call LIS_verify(status, & + "Error: Enable Qair in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_SWdown%varname(1),swdField,rc=status) + call LIS_verify(status, & + "Error: Enable SWdown in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_LWdown%varname(1),lwdField,rc=status) + call LIS_verify(status, & + "Error: Enable LWdown in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Wind_E%varname(1),uField,rc=status) + call LIS_verify(status, & + "Error: Enable Wind_E in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Wind_N%varname(1),vField,rc=status) + call LIS_verify(status, & + "Error: Enable Wind_N in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Psurf%varname(1),psurfField,rc=status) + call LIS_verify(status, & + "Error: Enable Psurf in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Rainf%varname(1),pcpField,rc=status) + call LIS_verify(status, & + "Error: Enable Rainf in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_CRainf%varname(1),cpcpField,rc=status) + call LIS_verify(status, & + "Error: Enable CRainf in the forcing variables list") + + forcing_z = .false. + forcing_ch = .false. + if (nldas20_struc(n)%model_level_data.eq.1) then + if (LIS_FORC_Forc_Hgt%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Forc_Hgt%varname(1),fhgtField,rc=status) + call LIS_verify(status, & + "Error: Enable Forc_Hgt in the forcing variables list") + forcing_z = .true. + else + write(LIS_logunit,*) & + "[ERR] Trying to use the NLDAS-2 FORB forcing data" + write(LIS_logunit,*) & + "[ERR] without turning on Forc_Hgt variable in the" + write(LIS_logunit,*) & + "[ERR] Forcing variable list file. Please turn the" + write(LIS_logunit,*) & + "[ERR] Forc_Hgt variable on when using FORB data." + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + + if (LIS_FORC_Ch%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Ch%varname(1),acondField,rc=status) + call LIS_verify(status, & + "Error: Enable Ch in the forcing variables list") + forcing_ch = .true. + else + write(LIS_logunit,*) & + "[ERR] Trying to use the NLDAS-2 FORB forcing data" + write(LIS_logunit,*) & + "[ERR] without turning on Ch variable in the" + write(LIS_logunit,*) & + "[ERR] Forcing variable list file. Please turn the" + write(LIS_logunit,*) & + "[ERR] Ch variable on when using FORB data." + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + endif + + if (LIS_FORC_PET%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_PET%varname(1),PETField,rc=status) + call LIS_verify(status, & + "Error: Enable PET in the forcing variables list") + forcing_pet = .true. + else + forcing_pet = .false. + endif + + if (LIS_FORC_CAPE%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_CAPE%varname(1),CAPEField,rc=status) + call LIS_verify(status, & + "Error: Enable CAPE in the forcing variables list") + forcing_cape = .true. + else + forcing_cape = .false. + endif + + call ESMF_FieldGet(swdField,localDE=0,farrayPtr=swd,rc=status) + call LIS_verify(status) + +! Loop over number of forcing ensembles: + mfactor = LIS_rc%nensem(n) / nldas20_struc(n)%nIter + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + zdoy = LIS_rc%doy +! Compute and apply zenith angle weights + call zterp(1,LIS_domain(n)%grid(index1)%lat, & + LIS_domain(n)%grid(index1)%lon, & + gmt1,gmt2,LIS_rc%gmt,zdoy,zw1,zw2, & + czb,cze,czm,LIS_rc) + + kk = LIS_get_iteration_index(n,k,index1,mfactor) + + if ((nldas20_struc(n)%metdata1(kk,3,index1).ne.LIS_rc%udef).and. & + (nldas20_struc(n)%metdata2(kk,3,index1).ne.LIS_rc%udef)) then + swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*zw1) + & + (nldas20_struc(n)%metdata2(kk,3,index1)*zw2) +! In cases of small cos(zenith) angles, use linear weighting +! to avoid overly large weights. + if ((swd(t).gt.nldas20_struc(n)%metdata1(kk,3,index1)).and.& + (swd(t).gt.nldas20_struc(n)%metdata2(kk,3,index1)).and.& + ((czb.lt.0.1).or.(cze.lt.0.1))) then + swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*swt1)+ & + (nldas20_struc(n)%metdata2(kk,3,index1)*swt2) + endif + endif + + if (swd(t).gt.LIS_CONST_SOLAR) then + write(unit=LIS_logunit,fmt=*) & + "[WARN] sw radiation too high!!" + write(unit=LIS_logunit,fmt=*) & + "[WARN] it is: ",swd(t) + write(unit=LIS_logunit,fmt=*) & + "[WARN] data1 =",nldas20_struc(n)%metdata1(kk,3,index1) + write(unit=LIS_logunit,fmt=*) & + "[WARN] data2 =",nldas20_struc(n)%metdata2(kk,3,index1) + write(unit=LIS_logunit,fmt=*) & + "[WARN] zw1 =",zw1,"zw2 =",zw2 + write(unit=LIS_logunit,fmt=*) & + "[WARN] swt1 =",swt1,"swt2 =",swt2 + endif + enddo + enddo ! End for SWdown + +! Do block precipitation interpolation + call ESMF_FieldGet(pcpField,localDE=0,farrayPtr=pcp,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if (nldas20_struc(n)%metdata2(kk,8,index1).ne.LIS_rc%udef) then + pcp(t) = nldas20_struc(n)%metdata2(kk,8,index1) + pcp(t) = pcp(t) / (60.0*60.0) + endif + enddo + enddo + + call ESMF_FieldGet(cpcpField,localDE=0,farrayPtr=cpcp,rc=status) + call LIS_verify(status) + +! Input is actually convective precip fraction; Calc actual CPCP below + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if (nldas20_struc(n)%metdata2(kk,9,index1).ne.LIS_rc%udef) then + cpcp(t) = nldas20_struc(n)%metdata2(kk,9,index1) + if (nldas20_struc(n)%model_pcp_data.gt.0) then + cpcp(t) = cpcp(t) / (60.0*60.0) + else + cpcp(t) = cpcp(t) * pcp(t) + endif + endif + enddo + enddo + +! Linearly interpolate everything else + call ESMF_FieldGet(tmpField,localDE=0,farrayPtr=tmp,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,1,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,1,index1).ne.LIS_rc%udef)) then + tmp(t) = (nldas20_struc(n)%metdata1(kk,1,index1)*wt1) + & + (nldas20_struc(n)%metdata2(kk,1,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(q2Field,localDE=0,farrayPtr=q2,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,2,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,2,index1).ne.LIS_rc%udef)) then + q2(t) = (nldas20_struc(n)%metdata1(kk,2,index1)*wt1) + & + (nldas20_struc(n)%metdata2(kk,2,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(lwdField,localDE=0,farrayPtr=lwd,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,4,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,4,index1).ne.LIS_rc%udef)) then + lwd(t) = (nldas20_struc(n)%metdata1(kk,4,index1)*wt1) + & + (nldas20_struc(n)%metdata2(kk,4,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(uField,localDE=0,farrayPtr=uwind,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,5,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,5,index1).ne.LIS_rc%udef)) then + uwind(t) = (nldas20_struc(n)%metdata1(kk,5,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,5,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(vField,localDE=0,farrayPtr=vwind,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,6,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,6,index1).ne.LIS_rc%udef)) then + vwind(t) = (nldas20_struc(n)%metdata1(kk,6,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,6,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(psurfField,localDE=0,farrayPtr=psurf,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,7,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,7,index1).ne.LIS_rc%udef)) then + psurf(t) = (nldas20_struc(n)%metdata1(kk,7,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,7,index1)*wt2) + endif + enddo + enddo + + if (forcing_PET) then + call ESMF_FieldGet(PETField,localDE=0,farrayPtr=pet,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,10,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,10,index1).ne.LIS_rc%udef)) then + pet(t) = (nldas20_struc(n)%metdata1(kk,10,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,10,index1)*wt2) +! Convert NLDAS-2 PET from kg/m^2 to kg/m^2/sec - dmm + pet(t) = pet(t)/(60.0*60.0) + endif + enddo + enddo + endif + + if (forcing_CAPE) then + call ESMF_FieldGet(CAPEField,localDE=0,farrayPtr=cape,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,11,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,11,index1).ne.LIS_rc%udef)) then + cape(t) = (nldas20_struc(n)%metdata1(kk,11,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,11,index1)*wt2) + endif + enddo + enddo + endif + + if (forcing_z) then + call ESMF_FieldGet(fhgtField,localDE=0,farrayPtr=fheight,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,12,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,12,index1).ne.LIS_rc%udef)) then + fheight(t) = (nldas20_struc(n)%metdata1(kk,12,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,12,index1)*wt2) + endif + enddo + enddo + endif + + if (forcing_ch) then + call ESMF_FieldGet(acondField,localDE=0,farrayPtr=acond,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,13,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,13,index1).ne.LIS_rc%udef)) then + acond(t) = (nldas20_struc(n)%metdata1(kk,13,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,13,index1)*wt2) + endif + enddo + enddo + endif + + end subroutine timeinterp_nldas20 + diff --git a/lis/plugins/LIS_metforcing_pluginMod.F90 b/lis/plugins/LIS_metforcing_pluginMod.F90 index 9136d42bf..d889437f6 100644 --- a/lis/plugins/LIS_metforcing_pluginMod.F90 +++ b/lis/plugins/LIS_metforcing_pluginMod.F90 @@ -208,6 +208,10 @@ subroutine LIS_metforcing_plugin use nldas2_forcingMod #endif +#if ( defined MF_NLDAS20 ) + use nldas20_forcingMod +#endif + #if ( defined MF_NARR ) use narr_forcingMod #endif @@ -504,6 +508,13 @@ subroutine LIS_metforcing_plugin external reset_nldas2 #endif +#if ( defined MF_NLDAS20 ) + external get_nldas20 + external timeinterp_nldas20 + external finalize_nldas20 + external reset_nldas20 +#endif + #if ( defined MF_NARR ) external get_narr external timeinterp_narr @@ -970,7 +981,7 @@ subroutine LIS_metforcing_plugin #endif #if ( defined MF_NLDAS2 ) -! - NLDAS2 Forcing: +! - NLDAS2 Forcing (GRIB-1 format): call registerinitmetforc(trim(LIS_nldas2Id)//char(0),init_NLDAS2) call registerretrievemetforc(trim(LIS_nldas2Id)//char(0),get_nldas2) call registertimeinterpmetforc(trim(LIS_nldas2Id)//char(0), & @@ -979,6 +990,16 @@ subroutine LIS_metforcing_plugin call registerresetmetforc(trim(LIS_nldas2Id)//char(0),reset_nldas2) #endif +#if ( defined MF_NLDAS20 ) +! - NLDAS-2.0 Forcing (netCDF format): + call registerinitmetforc(trim(LIS_nldas20Id)//char(0),init_NLDAS20) + call registerretrievemetforc(trim(LIS_nldas20Id)//char(0),get_nldas20) + call registertimeinterpmetforc(trim(LIS_nldas20Id)//char(0), & + timeinterp_nldas20) + call registerfinalmetforc(trim(LIS_nldas20Id)//char(0),finalize_nldas20) + call registerresetmetforc(trim(LIS_nldas20Id)//char(0),reset_nldas20) +#endif + #if ( defined MF_NARR ) ! - NARR profile data for CRTM call registerinitmetforc(trim(LIS_narrId)//char(0),init_NARR) diff --git a/lis/plugins/LIS_pluginIndices.F90 b/lis/plugins/LIS_pluginIndices.F90 index c6623509a..81fc78686 100644 --- a/lis/plugins/LIS_pluginIndices.F90 +++ b/lis/plugins/LIS_pluginIndices.F90 @@ -130,8 +130,8 @@ module LIS_pluginIndices character*50, public, parameter :: LIS_gswp2Id = "GSWP2" character*50, public, parameter :: LIS_agrmetId = "AGRMET" character*50, public, parameter :: LIS_princetonId = "PRINCETON" - character*50, public, parameter :: LIS_nldas2Id = "NLDAS2" - + character*50, public, parameter :: LIS_nldas2Id = "NLDAS2 grib" + character*50, public, parameter :: LIS_nldas20Id = "NLDAS2 netcdf" character*50, public, parameter :: LIS_gldasId = "GLDAS" character*50, public, parameter :: LIS_gfsId = "GFS" character*50, public, parameter :: LIS_merra2Id = "MERRA2" From 140d1252dda27ef1fcc4a8800b83acc11f9bf9c9 Mon Sep 17 00:00:00 2001 From: "James V. Geiger" Date: Fri, 19 Jul 2024 09:24:01 -0400 Subject: [PATCH 02/12] Remove unneeded #include --- lis/metforcing/nldas-2.0/finalize_nldas20.F90 | 1 - lis/metforcing/nldas-2.0/reset_nldas20.F90 | 1 - lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 | 1 - 3 files changed, 3 deletions(-) diff --git a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 index 507744f69..40bf23d47 100644 --- a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 @@ -7,7 +7,6 @@ ! Administrator of the National Aeronautics and Space Administration. ! All Rights Reserved. !-------------------------END NOTICE -- DO NOT EDIT----------------------- -#include "LIS_misc.h" !BOP ! !MODULE: finalize_nldas20 ! \label{finalize_nldas20} diff --git a/lis/metforcing/nldas-2.0/reset_nldas20.F90 b/lis/metforcing/nldas-2.0/reset_nldas20.F90 index a27369140..320213de7 100644 --- a/lis/metforcing/nldas-2.0/reset_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/reset_nldas20.F90 @@ -7,7 +7,6 @@ ! Administrator of the National Aeronautics and Space Administration. ! All Rights Reserved. !-------------------------END NOTICE -- DO NOT EDIT----------------------- -#include "LIS_misc.h" !BOP ! !MODULE: reset_nldas20 ! \label{reset_nldas20} diff --git a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 index e9f65642c..928781130 100644 --- a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 @@ -7,7 +7,6 @@ ! Administrator of the National Aeronautics and Space Administration. ! All Rights Reserved. !-------------------------END NOTICE -- DO NOT EDIT----------------------- -#include "LIS_misc.h" !BOP ! !ROUTINE: timeinterp_nldas20 ! \label{timeinterp_nldas20} From ec6815b8078e221e8a36f5a408e274236d26b166 Mon Sep 17 00:00:00 2001 From: "James V. Geiger" Date: Fri, 19 Jul 2024 09:26:03 -0400 Subject: [PATCH 03/12] Fix typos in log messages --- lis/metforcing/nldas-2.0/get_nldas20.F90 | 4 ++-- lis/metforcing/nldas-2.0/read_nldas20_elev.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lis/metforcing/nldas-2.0/get_nldas20.F90 b/lis/metforcing/nldas-2.0/get_nldas20.F90 index 4e7d52bb3..dd8ed41e6 100644 --- a/lis/metforcing/nldas-2.0/get_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/get_nldas20.F90 @@ -212,7 +212,7 @@ subroutine get_nldas20(n,findex) call LIS_tick(dtime1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) if (try.gt.11) then write(LIS_logunit,*) & - "[ERR} NLDAS-2 data gap exceeds 10 days on file 1" + "[ERR] NLDAS-2 data gap exceeds 10 days on file 1" write(LIS_logunit,*) "[ERR] Program stopping ..." call LIS_endrun() endif @@ -260,7 +260,7 @@ subroutine get_nldas20(n,findex) call LIS_tick(dtime2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) if (try.gt.11) then write(LIS_logunit,*) & - "[ERR} NLDAS-2 data gap exceeds 10 days on file 2" + "[ERR] NLDAS-2 data gap exceeds 10 days on file 2" write(LIS_logunit,*) "[ERR] Program stopping ..." call LIS_endrun() endif diff --git a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 index 3f36479e2..011a80157 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 @@ -90,7 +90,7 @@ subroutine read_nldas20_elev(n,findex) endif write(LIS_logunit,*) & - "Finished reading original NLDAS-2 elevation data" + "[INFO] Finished reading original NLDAS-2 elevation data" #endif end subroutine read_nldas20_elev From f4130550bc028b2d3a2c25705d1128f91872b2bf Mon Sep 17 00:00:00 2001 From: "James V. Geiger" Date: Fri, 19 Jul 2024 09:41:50 -0400 Subject: [PATCH 04/12] Rename the NLDAS2 and NLDAS-2.0 sections --- lis/configs/lis.config.adoc | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lis/configs/lis.config.adoc b/lis/configs/lis.config.adoc index e3d04a0c5..11998bbdf 100644 --- a/lis/configs/lis.config.adoc +++ b/lis/configs/lis.config.adoc @@ -5874,8 +5874,8 @@ SCAN forcing directory: ./input/FORCING/SCAN SCAN metadata file: ./input/FORCING/SCAN/msu_scan.mdata .... -[[sssec_forcings_nldas2,NLDAS2]] -==== NLDAS2 +[[sssec_forcings_nldas2,NLDAS2 (grib)]] +==== NLDAS2 (grib) `NLDAS2 forcing directory:` specifies the location of the NLDAS-2 GRIB-1 forcing files. @@ -5959,8 +5959,8 @@ NLDAS2 use model based precip: 0 NLDAS2 use model based pressure: 0 .... -[[sssec_forcings_nldas20,NLDAS20]] -==== NLDAS-2.0 +[[sssec_forcings_nldas20,NLDAS-2.0 (netcdf)]] +==== NLDAS-2.0 (netcdf) `NLDAS-2.0 FORA forcing directory:` specifies the location of the NLDAS-2.0 v020 "`FORA`" netCDF-4 forcing files. From 0e5d74e7c2613c9e2113fc1b75d01f06ab3a8ed4 Mon Sep 17 00:00:00 2001 From: David Mocko Date: Fri, 19 Jul 2024 11:55:18 -0400 Subject: [PATCH 05/12] Correct NLDAS-2.0 netCDF REVISION HISTORY in-line documentation --- lis/metforcing/nldas-2.0/finalize_nldas20.F90 | 5 ++- .../nldas-2.0/get_netcdf4_filenames.F90 | 18 +++------- lis/metforcing/nldas-2.0/get_nldas20.F90 | 7 ++-- .../nldas-2.0/nldas20_ec_removal.F90 | 7 ++-- .../nldas-2.0/nldas20_forcingMod.F90 | 10 +++--- .../nldas-2.0/read_nldas20_elev.F90 | 11 +++--- lis/metforcing/nldas-2.0/read_nldas20a.F90 | 34 ++++--------------- lis/metforcing/nldas-2.0/read_nldas20b.F90 | 31 ++--------------- .../nldas-2.0/read_orig_nldas20_elevdiff.F90 | 7 ++-- lis/metforcing/nldas-2.0/readcrd_nldas20.F90 | 8 ++--- lis/metforcing/nldas-2.0/reset_nldas20.F90 | 6 ++-- .../nldas-2.0/timeinterp_nldas20.F90 | 6 ++-- 12 files changed, 38 insertions(+), 112 deletions(-) diff --git a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 index 40bf23d47..5a7c28698 100644 --- a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 @@ -12,9 +12,8 @@ ! \label{finalize_nldas20} ! ! !REVISION HISTORY: -! 25 Oct 2005: Sujay Kumar, Initial Code -! 24 Aug 2007: Chuck Alonge, Modified for use with NLDAS-2 data -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from finalize_nldas2.F90) ! ! !INTERFACE: subroutine finalize_nldas20(findex) diff --git a/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 index 7104fd288..4aa3f02d0 100644 --- a/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 +++ b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 @@ -12,13 +12,8 @@ ! \label{netcdf4_nldas20filea} ! ! !REVISION HISTORY: -! 1 Oct 1999: Jared Entin; Initial code -! 15 Oct 1999: Paul Houser; Significant F90 Revision -! 04 Sep 2001: Brian Cosgrove; Use of NASA data enabled, updated -! reading of data directory structure to read new format -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data -! 22 Jan 2012: K. Arsenault; Accommodate GES DISC, NCEP/EMC filename conventions -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from get_gesdisc_filenames.F90) ! ! !INTERFACE: subroutine netcdf4_nldas20filea(n,kk,findex,filename, & @@ -119,13 +114,8 @@ end subroutine netcdf4_nldas20filea ! \label{netcdf4_nldas20fileb} ! ! !REVISION HISTORY: -! 1 Oct 1999: Jared Entin; Initial code -! 15 Oct 1999: Paul Houser; Significant F90 Revision -! 04 Sep 2001: Brian Cosgrove; Use of NASA data enabled, updated -! reading of data directory structure to read new format -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data -! 22 Jan 2012: K. Arsenault; Accommodate GES DISC, GES DISC filename conventions -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from get_gesdisc_filenames.F90) ! ! !INTERFACE: subroutine netcdf4_nldas20fileb(n,kk,findex,filename, & diff --git a/lis/metforcing/nldas-2.0/get_nldas20.F90 b/lis/metforcing/nldas-2.0/get_nldas20.F90 index dd8ed41e6..3cb940292 100644 --- a/lis/metforcing/nldas-2.0/get_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/get_nldas20.F90 @@ -12,11 +12,8 @@ ! \label{get_nldas20} ! ! !REVISION HISTORY: -! 02 Feb 2004: Sujay Kumar; Initial Version in LIS -! 22 Aug 2007: Chuck Alonge; Updated for NLDAS2 Forcing -! 22 Jan 2012: K. Arsenault; Accommodate GESDISC, NCEP filename conventions -! 14 Mar 2014: David Mocko: Trim writing of filenames to log file -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from get_nldas2.F90) ! ! !INTERFACE: subroutine get_nldas20(n,findex) diff --git a/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 b/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 index 23b190726..3365ef0b6 100644 --- a/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 +++ b/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 @@ -12,9 +12,8 @@ ! \label{nldas20_ec_removal} ! ! !REVISION HISTORY: -! 20 Oct 2006: Kristi Arsenault; Adapted elevation correction code -! to remove such a correction from NLDAS2 fields -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from nldas2_ec_removal.F90) ! ! !INTERFACE: subroutine nldas20_ec_removal(nest,point,force_tmp,force_hum, & @@ -38,7 +37,7 @@ subroutine nldas20_ec_removal(nest,point,force_tmp,force_hum, & ! to these variables described in Cosgrove et. al (2003). ! ! Cosgrove, B.A. et.al, Real-time and retrospective forcing in the -! North American Land Data Assimilation (NLDAS2) project, Journal of +! North American Land Data Assimilation (NLDAS) project, Journal of ! Geophysical Research, 108(D22), 8842, DOI: 10.1029/2002JD003118, 2003. ! ! The arguments are: diff --git a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 index 6e0863a93..43ce0f13f 100644 --- a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 +++ b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 @@ -12,10 +12,8 @@ module nldas20_forcingMod ! !MODULE: nldas20_forcingMod ! ! !REVISION HISTORY: -! 02 Feb 2004: Sujay Kumar; Initial Specification -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data -! 14 Mar 2014: David Mocko: Added CAPE and PET forcing from NLDAS-2 -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from nldas2_forcingMod.F90) ! ! !USES: use LIS_constantsMod, only : LIS_CONST_PATH_LEN @@ -41,7 +39,7 @@ module nldas20_forcingMod ! at the following URL: ! https://ldas.gsfc.nasa.gov/nldas/v2/forcing ! -! The implemenatation in LIS has the derived data type {\tt nldas20\_struc} +! The implementation in LIS has the derived data type {\tt nldas20\_struc} ! that includes the variables that specify the runtime options, and the ! weights and neighbor information to be used for spatial interpolation. ! They are described below: @@ -316,7 +314,7 @@ subroutine init_NLDAS20(findex) call LIS_endrun() end select -! Read in elevation difference and NLDAS2 elevation maps: +! Read in elevation difference and NLDAS-2 elevation maps: if (LIS_rc%met_ecor(findex).ne."none") then allocate(nldas20_struc(n)%orig_ediff( & nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) diff --git a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 index 011a80157..e9b79fa29 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 @@ -13,9 +13,8 @@ ! \label{read_nldas20_elev} ! ! !REVISION HISTORY: -! 17 Dec 2004; Sujay Kumar; Initial Specificaton -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS2 data -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from read_nldas2_elev.F90) ! ! !INTERFACE: subroutine read_nldas20_elev(n,findex) @@ -36,8 +35,8 @@ subroutine read_nldas20_elev(n,findex) ! ! !DESCRIPTION: ! -! Opens, reads, and interpolates NLDAS2 model elevation to the LIS -! grid. The data will be used to perform any topographical +! Opens, reads, and interpolates NLDAS-2 model elevation to the +! LIS grid. The data will be used to perform any topographical ! adjustments to the forcing. ! ! The arguments are: @@ -90,7 +89,7 @@ subroutine read_nldas20_elev(n,findex) endif write(LIS_logunit,*) & - "[INFO] Finished reading original NLDAS-2 elevation data" + "[INFO] Finished reading original NLDAS-2 elevation data" #endif end subroutine read_nldas20_elev diff --git a/lis/metforcing/nldas-2.0/read_nldas20a.F90 b/lis/metforcing/nldas-2.0/read_nldas20a.F90 index 3ef0693f7..5d7c3f433 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20a.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20a.F90 @@ -13,34 +13,8 @@ ! \label{read_nldas20a} ! ! !REVISION HISTORY: -! 11 Apr 2000: Brian Cosgrove; changed code to use Forcing Mask (With -! inland water filled in). Deleted unused variables. -! 27 Apr 2000: Brian Cosgrove; changed code to use the original -! mask again since that is the -! mask which NCEP has already applied to the forcing data -! by the time NASA gets it......not possible to use the -! expanded NASA forcing mask -! 1 May 2000: Brian Cosgrove; changed code so that if parameter 11 (sw) -! is not found in hourly ncep data, it will just use -! edas-based shortwave from the hourly ncep files -! 20 Jun 2000: Brian Cosgrove; changed code so that it uses LDAS%UDEF and -! not a hard-wired undefined value of -999.9 and -999.0 -! 18 Aug 2000: Brian Cosgrove; changed code so that FMASK and not MASK -! is used when ungribbing. NCEP data already has a mask applied -! to it and so may not be able to supply forcing data to -! all LDAS land forcing points. In areas where LDAS -! forcing mask states that land exists, but where NCEP forcing -! data is non-existent, assign undefined value to forcing data. -! 22 Aug 2000: Brian Cosgrove; Altered code for US/Mexico/Canada Mask -! 05 Sep 2001: Brian Cosgrove; Removed dirnom and infile variables, changed -! call to ungribncep to match removal. Added code to make use -! of precip weighting mask -! 02 Feb 2004: Sujay Kumar; Initial Specification in LIS -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data -! 25 Jan 2012: Sujay Kumar; Switched to the use of grib-api library -! 14 Mar 2014: David Mocko: Added CAPE and PET forcing from NLDAS-2 -! 16 Oct 2017: Bailing Li: Modified interp_nldas2 to read climatology ratios -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from read_nldas2a.F90) ! ! !INTERFACE: subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) @@ -222,6 +196,10 @@ end subroutine read_nldas20a ! !ROUTINE: interp_nldas20 ! \label{interp_nldas20} ! +! !REVISION HISTORY: +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from read_nldas2a.F90) +! ! !INTERFACE: subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & input_data,input_bitmap,lis_gds,nc,nr,output_2d) diff --git a/lis/metforcing/nldas-2.0/read_nldas20b.F90 b/lis/metforcing/nldas-2.0/read_nldas20b.F90 index b1c52ef6d..faf8c3f23 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20b.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20b.F90 @@ -13,35 +13,8 @@ ! \label{read_nldas20b} ! ! !REVISION HISTORY: -! 11 Apr 2000: Brian Cosgrove; changed code to use Forcing Mask (With -! inland water filled in). Deleted unused variables. -! 27 Apr 2000: Brian Cosgrove; changed code to use the original -! mask again since that is the -! mask which NCEP has already applied to the forcing data -! by the time NASA gets it......not possible to use the -! expanded NASA forcing mask -! 1 May 2000: Brian Cosgrove; changed code so that if parameter 11 (sw) -! is not found in hourly ncep data, it will just use -! edas-based shortwave from the hourly ncep files -! 20 Jun 2000: Brian Cosgrove; changed code so that it uses LDAS%UDEF and -! not a hard-wired undefined value of -999.9 and -999.0 -! 18 Aug 2000: Brian Cosgrove; changed code so that FMASK and not MASK -! is used when ungribbing. NCEP data already has a mask applied -! to it and so may not be able to supply forcing data to -! all LDAS land forcing points. In areas where LDAS -! forcing mask states that land exists, but where NCEP forcing -! data is non-existent, assign undefined value to forcing data. -! 22 Aug 2000: Brian Cosgrove; Altered code for US/Mexico/Canada Mask -! 05 Sep 2001: Brian Cosgrove; Removed dirnom and infile variables, changed -! call to ungribncep to match removal. Added code to make use -! of precip weighting mask -! 02 Feb 2004: Sujay Kumar; Initial Specification in LIS -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data -! 25 Jan 2012: Sujay Kumar; Switched to the use of grib-api library -! 14 Mar 2014: David Mocko: Fixed the use of Forcing "B" file data -! of NARR meteorology, radiation, precip, -! and/or forcing height fields -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from read_nldas2b.F90) ! ! !INTERFACE: subroutine read_nldas20b(n,kk,findex,order,name,ferror) diff --git a/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 index 3a4532307..811ad974d 100644 --- a/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 +++ b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 @@ -13,9 +13,8 @@ ! \label{read_orig_nldas20_elevdiff} ! ! !REVISION HISTORY: -! 7 Nov 2012: Sujay Kumar - initial specification based on the NLDAS-1 -! implementation -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from read_orig_nldas2_elevdiff.F90) ! ! !INTERFACE: subroutine read_orig_nldas20_elevdiff(n) @@ -72,7 +71,7 @@ subroutine read_orig_nldas20_elevdiff(n) endif write(LIS_logunit,*) "[INFO] Finished reading original NLDAS-2" - write(LIS_logunit,*) "[INFO] NLDAS2 elevation difference data.." + write(LIS_logunit,*) "[INFO] elevation difference data." #endif end subroutine read_orig_nldas20_elevdiff diff --git a/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 index c665753fe..d0b04e88e 100644 --- a/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 @@ -13,12 +13,8 @@ ! \label{readcrd_nldas20} ! ! !REVISION HISTORY: -! 02Feb2004; Sujay Kumar, Initial Code -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS2 data -! 22 Jan 2012: K. Arsenault; Accommodate GES DISC, NCEP filename conventions -! 14 Mar 2014: David Mocko: Removed elevation file line in config file, -! as this data is now in the LDT input file. -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from readcrd_nldas2.F90) ! ! !INTERFACE: subroutine readcrd_nldas20() diff --git a/lis/metforcing/nldas-2.0/reset_nldas20.F90 b/lis/metforcing/nldas-2.0/reset_nldas20.F90 index 320213de7..7ac80913f 100644 --- a/lis/metforcing/nldas-2.0/reset_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/reset_nldas20.F90 @@ -12,8 +12,8 @@ ! \label{reset_nldas20} ! ! !REVISION HISTORY: -! 25 Oct 2005; Sujay Kumar, Initial Code -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from reset_nldas2.F90) ! ! !INTERFACE: subroutine reset_nldas20() @@ -24,7 +24,7 @@ subroutine reset_nldas20() implicit none ! ! !DESCRIPTION: -! Routine to reset nldas2 forcing related memory allocations. +! Routine to reset NLDAS-2 forcing related memory allocations. ! !EOP integer :: n diff --git a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 index 928781130..2012874ac 100644 --- a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 @@ -12,10 +12,8 @@ ! \label{timeinterp_nldas20} ! ! !REVISION HISTORY: -! 02 Feb 2004: Sujay Kumar; Initial Specification -! 24 Aug 2007: Chuck Alonge; Modified for use with NLDAS-2 data -! 14 Mar 2014: David Mocko: Added CAPE and PET forcing from NLDAS-2 -! 11 Jul 2024: David Mocko, Modified for use with netCDF-4 format +! 11 Jul 2024: David Mocko, Initial Specification +! (derived from timeinterp_nldas2.F90) ! ! !INTERFACE: subroutine timeinterp_nldas20(n,findex) From ca2ca55e5f52e7e97448b20cafb5b0cb41904662 Mon Sep 17 00:00:00 2001 From: "James V. Geiger" Date: Fri, 19 Jul 2024 12:31:52 -0400 Subject: [PATCH 06/12] Correct documentation --- lis/metforcing/nldas-2.0/finalize_nldas20.F90 | 2 +- lis/metforcing/nldas-2.0/reset_nldas20.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 index 5a7c28698..fd8ae32b8 100644 --- a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 @@ -8,7 +8,7 @@ ! All Rights Reserved. !-------------------------END NOTICE -- DO NOT EDIT----------------------- !BOP -! !MODULE: finalize_nldas20 +! !ROUTINE: finalize_nldas20 ! \label{finalize_nldas20} ! ! !REVISION HISTORY: diff --git a/lis/metforcing/nldas-2.0/reset_nldas20.F90 b/lis/metforcing/nldas-2.0/reset_nldas20.F90 index 7ac80913f..1f3b32a2e 100644 --- a/lis/metforcing/nldas-2.0/reset_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/reset_nldas20.F90 @@ -8,7 +8,7 @@ ! All Rights Reserved. !-------------------------END NOTICE -- DO NOT EDIT----------------------- !BOP -! !MODULE: reset_nldas20 +! !ROUTINE: reset_nldas20 ! \label{reset_nldas20} ! ! !REVISION HISTORY: From 925d0db0f4f567218eebc198d7fcf9a841558916 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 22 Jul 2024 09:10:43 -0400 Subject: [PATCH 07/12] Removed unused variable import, and added external statements. These are not strictly speaking required, but it removes warning messages from ifort when strict checking is turned on. --- lis/metforcing/nldas-2.0/get_nldas20.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lis/metforcing/nldas-2.0/get_nldas20.F90 b/lis/metforcing/nldas-2.0/get_nldas20.F90 index 3cb940292..aa16c2c5f 100644 --- a/lis/metforcing/nldas-2.0/get_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/get_nldas20.F90 @@ -18,7 +18,7 @@ ! !INTERFACE: subroutine get_nldas20(n,findex) ! !USES: - use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_coreMod, only : LIS_rc use LIS_timeMgrMod, only : LIS_tick use LIS_metforcingMod, only : LIS_forc use LIS_logMod, only : LIS_logunit,LIS_endrun @@ -71,6 +71,11 @@ subroutine get_nldas20(n,findex) integer :: movetime ! 1=move time 2 data into time 1 integer :: kk ! Forecast member index + external :: netcdf4_nldas20filea + external :: read_nldas20a + external :: netcdf4_nldas20fileb + external :: read_nldas20b + !=== End Variable Definition =========================================== try = -999 From bb353535ffc12a209037d4eddfb3a4508869074d Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 22 Jul 2024 09:47:31 -0400 Subject: [PATCH 08/12] Removed unused imported variable, and added external statements. This is to address warning messages from ifort when run with strict checks. --- lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 index 43ce0f13f..e78571d8e 100644 --- a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 +++ b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 @@ -127,7 +127,7 @@ module nldas20_forcingMod ! !INTERFACE: subroutine init_NLDAS20(findex) ! !USES: - use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_coreMod, only : LIS_rc use LIS_timeMgrMod, only : LIS_update_timestep use LIS_logMod, only : LIS_logunit,LIS_endrun use map_utils, only : proj_latlon @@ -160,6 +160,14 @@ subroutine init_NLDAS20(findex) !EOP integer :: n + external :: readcrd_nldas20 + external :: bilinear_interp_input + external :: conserv_interp_input + external :: neighbor_interp_input + external :: read_orig_nldas20_elevdiff + external :: read_nldas20_elev + + allocate(nldas20_struc(LIS_rc%nnest)) call readcrd_nldas20() From e73e62cb59eb00895ab161522d4a987ee900c2fa Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 22 Jul 2024 11:12:57 -0400 Subject: [PATCH 09/12] Removed unused variables. --- lis/metforcing/nldas-2.0/read_nldas20_elev.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 index e9b79fa29..4ff4ea7f2 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 @@ -52,7 +52,6 @@ subroutine read_nldas20_elev(n,findex) ! \end{description} ! !EOP - integer :: i, err logical :: file_exists integer :: nid,elevId integer :: c,r From 0993d3cf266b511f637c677d4c63ad3225440c1f Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 22 Jul 2024 17:01:49 -0400 Subject: [PATCH 10/12] Updated indentation. Identical results are produced. --- lis/metforcing/nldas-2.0/finalize_nldas20.F90 | 86 +- .../nldas-2.0/get_netcdf4_filenames.F90 | 202 ++--- lis/metforcing/nldas-2.0/get_nldas20.F90 | 380 ++++---- .../nldas-2.0/nldas20_ec_removal.F90 | 94 +- .../nldas-2.0/nldas20_forcingMod.F90 | 430 ++++----- .../nldas-2.0/read_nldas20_elev.F90 | 84 +- lis/metforcing/nldas-2.0/read_nldas20a.F90 | 442 ++++----- lis/metforcing/nldas-2.0/read_nldas20b.F90 | 423 +++++---- .../nldas-2.0/read_orig_nldas20_elevdiff.F90 | 66 +- lis/metforcing/nldas-2.0/readcrd_nldas20.F90 | 158 ++-- lis/metforcing/nldas-2.0/reset_nldas20.F90 | 22 +- .../nldas-2.0/timeinterp_nldas20.F90 | 856 +++++++++--------- 12 files changed, 1621 insertions(+), 1622 deletions(-) diff --git a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 index fd8ae32b8..992038740 100644 --- a/lis/metforcing/nldas-2.0/finalize_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/finalize_nldas20.F90 @@ -16,58 +16,58 @@ ! (derived from finalize_nldas2.F90) ! ! !INTERFACE: - subroutine finalize_nldas20(findex) +subroutine finalize_nldas20(findex) ! !USES: - use LIS_coreMod, only : LIS_rc - use nldas20_forcingMod, only : nldas20_struc + use LIS_coreMod, only : LIS_rc + use nldas20_forcingMod, only : nldas20_struc - implicit none + implicit none ! !ARGUMENTS: - integer :: findex + integer :: findex ! ! !DESCRIPTION: ! Routine to cleanup nldas20 forcing related memory allocations. ! !EOP - integer :: n + integer :: n - do n = 1,LIS_rc%nnest - if (trim(LIS_rc%met_interp(findex)).eq."bilinear") then - deallocate(nldas20_struc(n)%n111) - deallocate(nldas20_struc(n)%n121) - deallocate(nldas20_struc(n)%n211) - deallocate(nldas20_struc(n)%n221) - deallocate(nldas20_struc(n)%w111) - deallocate(nldas20_struc(n)%w121) - deallocate(nldas20_struc(n)%w211) - deallocate(nldas20_struc(n)%w221) - elseif (trim(LIS_rc%met_interp(findex)).eq."budget-bilinear") & - then - deallocate(nldas20_struc(n)%n111) - deallocate(nldas20_struc(n)%n121) - deallocate(nldas20_struc(n)%n211) - deallocate(nldas20_struc(n)%n221) - deallocate(nldas20_struc(n)%w111) - deallocate(nldas20_struc(n)%w121) - deallocate(nldas20_struc(n)%w211) - deallocate(nldas20_struc(n)%w221) - deallocate(nldas20_struc(n)%n112) - deallocate(nldas20_struc(n)%n122) - deallocate(nldas20_struc(n)%n212) - deallocate(nldas20_struc(n)%n222) - deallocate(nldas20_struc(n)%w112) - deallocate(nldas20_struc(n)%w122) - deallocate(nldas20_struc(n)%w212) - deallocate(nldas20_struc(n)%w222) - elseif(trim(LIS_rc%met_interp(findex)).eq."neighbor") then - deallocate(nldas20_struc(n)%n113) - endif + do n = 1,LIS_rc%nnest + if (trim(LIS_rc%met_interp(findex)).eq."bilinear") then + deallocate(nldas20_struc(n)%n111) + deallocate(nldas20_struc(n)%n121) + deallocate(nldas20_struc(n)%n211) + deallocate(nldas20_struc(n)%n221) + deallocate(nldas20_struc(n)%w111) + deallocate(nldas20_struc(n)%w121) + deallocate(nldas20_struc(n)%w211) + deallocate(nldas20_struc(n)%w221) + elseif (trim(LIS_rc%met_interp(findex)).eq."budget-bilinear") & + then + deallocate(nldas20_struc(n)%n111) + deallocate(nldas20_struc(n)%n121) + deallocate(nldas20_struc(n)%n211) + deallocate(nldas20_struc(n)%n221) + deallocate(nldas20_struc(n)%w111) + deallocate(nldas20_struc(n)%w121) + deallocate(nldas20_struc(n)%w211) + deallocate(nldas20_struc(n)%w221) + deallocate(nldas20_struc(n)%n112) + deallocate(nldas20_struc(n)%n122) + deallocate(nldas20_struc(n)%n212) + deallocate(nldas20_struc(n)%n222) + deallocate(nldas20_struc(n)%w112) + deallocate(nldas20_struc(n)%w122) + deallocate(nldas20_struc(n)%w212) + deallocate(nldas20_struc(n)%w222) + elseif(trim(LIS_rc%met_interp(findex)).eq."neighbor") then + deallocate(nldas20_struc(n)%n113) + endif - if (LIS_rc%met_ecor(findex).ne."none") then - deallocate(nldas20_struc(n)%orig_ediff) - endif - enddo - deallocate(nldas20_struc) + if (LIS_rc%met_ecor(findex).ne."none") then + deallocate(nldas20_struc(n)%orig_ediff) + endif + enddo + deallocate(nldas20_struc) - end subroutine finalize_nldas20 +end subroutine finalize_nldas20 diff --git a/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 index 4aa3f02d0..9558ed31b 100644 --- a/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 +++ b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 @@ -16,21 +16,21 @@ ! (derived from get_gesdisc_filenames.F90) ! ! !INTERFACE: - subroutine netcdf4_nldas20filea(n,kk,findex,filename, & - nldas20dir,yr,mo,da,doy,hr) +subroutine netcdf4_nldas20filea(n,kk,findex,filename, & + nldas20dir,yr,mo,da,doy,hr) ! !USES: - use LIS_coreMod - use LIS_logMod - use LIS_forecastMod + use LIS_coreMod + use LIS_logMod + use LIS_forecastMod - implicit none + implicit none ! !ARGUMENTS: - integer :: n - integer :: kk - integer :: findex - character(len=*), intent(out) :: filename - character(len=*), intent(in) :: nldas20dir - integer, intent(in) :: yr,mo,da,doy,hr + integer :: n + integer :: kk + integer :: findex + character(len=*), intent(out) :: filename + character(len=*), intent(in) :: nldas20dir + integer, intent(in) :: yr,mo,da,doy,hr ! ! !DESCRIPTION: ! This subroutine assembles GES DISC NLDAS-2 netCDF-4 "A" filenames @@ -55,59 +55,59 @@ subroutine netcdf4_nldas20filea(n,kk,findex,filename, & ! \end{description} ! !EOP - character*4 :: fyr - character*3 :: fdoy - character*2 :: fmo, fda, fhr - integer :: doy2 + character*4 :: fyr + character*3 :: fdoy + character*2 :: fmo, fda, fhr + integer :: doy2 !=== end variable definition =========================================== - if (LIS_rc%forecastMode.eq.0) then !hindcast run - write(unit=fyr, fmt="(i4.4)") yr - write(unit=fdoy,fmt="(i3.3)") doy - write(unit=fmo, fmt="(i2.2)") mo - write(unit=fda, fmt="(i2.2)") da - write(unit=fhr, fmt="(i2.2)") hr + if (LIS_rc%forecastMode.eq.0) then !hindcast run + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fdoy,fmt="(i3.3)") doy + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr !=== Assemble GES DISC NLDAS-2 netCDF-4 FORA filename: - filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & - "00.020.nc" + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" - else ! forecast mode - doy2 = doy + else ! forecast mode + doy2 = doy ! IF Forecast Year is a leap years, for doy: - if ((mod(LIS_rc%yr,4).eq.0.and.mod(LIS_rc%yr,100).ne.0) & - .or.(mod(LIS_rc%yr,400).eq.0)) then - if (doy.gt.59) then ! Make sure to remove extra day - doy2 = doy - 1 - endif - endif + if ((mod(LIS_rc%yr,4).eq.0.and.mod(LIS_rc%yr,100).ne.0) & + .or.(mod(LIS_rc%yr,400).eq.0)) then + if (doy.gt.59) then ! Make sure to remove extra day + doy2 = doy - 1 + endif + endif ! Sample yr, mo, da - call LIS_sample_forecastDate(n,kk,findex,yr,mo,da) + call LIS_sample_forecastDate(n,kk,findex,yr,mo,da) ! Account for member year - leap years for doy: - if ((mod(yr,4).eq.0.and.mod(yr,100).ne.0) & - .or.(mod(yr,400).eq.0)) then - if (doy.gt.59) then - doy2 = doy2 + 1 - endif - endif - - write(unit=fdoy,fmt="(i3.3)") doy2 - write(unit=fyr, fmt="(i4.4)") yr - write(unit=fmo, fmt="(i2.2)") mo - write(unit=fda, fmt="(i2.2)") da - write(unit=fhr, fmt="(i2.2)") hr + if ((mod(yr,4).eq.0.and.mod(yr,100).ne.0) & + .or.(mod(yr,400).eq.0)) then + if (doy.gt.59) then + doy2 = doy2 + 1 + endif + endif + + write(unit=fdoy,fmt="(i3.3)") doy2 + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr !=== Assemble GES DISC NLDAS-2 netCDF-4 FORA filename: - filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & - "00.020.nc" - endif + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" + endif - end subroutine netcdf4_nldas20filea +end subroutine netcdf4_nldas20filea !BOP ! !ROUTINE: netcdf4_nldas20fileb @@ -118,21 +118,21 @@ end subroutine netcdf4_nldas20filea ! (derived from get_gesdisc_filenames.F90) ! ! !INTERFACE: - subroutine netcdf4_nldas20fileb(n,kk,findex,filename, & +subroutine netcdf4_nldas20fileb(n,kk,findex,filename, & nldas20dir,yr,mo,da,doy,hr) ! !USES: - use LIS_coreMod - use LIS_logMod - use LIS_forecastMod + use LIS_coreMod + use LIS_logMod + use LIS_forecastMod - implicit none + implicit none ! !ARGUMENTS: - integer :: n - integer :: kk - integer :: findex - character(len=*), intent(out) :: filename - character(len=*), intent(in) :: nldas20dir - integer, intent(in) :: yr,mo,da,doy,hr + integer :: n + integer :: kk + integer :: findex + character(len=*), intent(out) :: filename + character(len=*), intent(in) :: nldas20dir + integer, intent(in) :: yr,mo,da,doy,hr ! ! !DESCRIPTION: ! This subroutine assembles GES DISC NLDAS-2 netCDF-4 "B" filenames @@ -157,57 +157,57 @@ subroutine netcdf4_nldas20fileb(n,kk,findex,filename, & ! \end{description} ! !EOP - character*4 :: fyr - character*3 :: fdoy - character*2 :: fmo, fda, fhr - integer :: doy2 + character*4 :: fyr + character*3 :: fdoy + character*2 :: fmo, fda, fhr + integer :: doy2 !=== end variable definition ============================================= - if (LIS_rc%forecastMode.eq.0) then !hindcast run - write(unit=fyr, fmt="(i4.4)") yr - write(unit=fdoy,fmt="(i3.3)") doy - write(unit=fmo, fmt="(i2.2)") mo - write(unit=fda, fmt="(i2.2)") da - write(unit=fhr, fmt="(i2.2)") hr + if (LIS_rc%forecastMode.eq.0) then !hindcast run + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fdoy,fmt="(i3.3)") doy + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr !=== Assemble GES DISC NLDAS-2 netCDF-4 FORB filename: - filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & - "00.020.nc" + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" - else !forecast mode - doy2 = doy + else !forecast mode + doy2 = doy ! IF Forecast Year is a leap years, for doy: - if ((mod(LIS_rc%yr,4).eq.0.and.mod(LIS_rc%yr,100).ne.0) & - .or.(mod(LIS_rc%yr,400).eq.0)) then - if (doy.gt.59) then ! Make sure to remove extra day - doy2 = doy - 1 - endif - endif + if ((mod(LIS_rc%yr,4).eq.0.and.mod(LIS_rc%yr,100).ne.0) & + .or.(mod(LIS_rc%yr,400).eq.0)) then + if (doy.gt.59) then ! Make sure to remove extra day + doy2 = doy - 1 + endif + endif ! Sample yr, mo, da - call LIS_sample_forecastDate(n,kk,findex,yr,mo,da) + call LIS_sample_forecastDate(n,kk,findex,yr,mo,da) ! Account for member year - leap years for doy: - if ((mod(yr,4).eq.0.and.mod(yr,100).ne.0) & - .or.(mod(yr,400).eq.0)) then - if (doy.gt.59) then - doy2 = doy + 1 - endif - endif - - write(unit=fdoy,fmt="(i3.3)") doy2 - write(unit=fyr, fmt="(i4.4)") yr - write(unit=fmo, fmt="(i2.2)") mo - write(unit=fda, fmt="(i2.2)") da - write(unit=fhr, fmt="(i2.2)") hr + if ((mod(yr,4).eq.0.and.mod(yr,100).ne.0) & + .or.(mod(yr,400).eq.0)) then + if (doy.gt.59) then + doy2 = doy + 1 + endif + endif + + write(unit=fdoy,fmt="(i3.3)") doy2 + write(unit=fyr, fmt="(i4.4)") yr + write(unit=fmo, fmt="(i2.2)") mo + write(unit=fda, fmt="(i2.2)") da + write(unit=fhr, fmt="(i2.2)") hr !=== Assemble GES DISC NLDAS-2 netCDF-4 FORB filename: - filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & - "00.020.nc" - endif + filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & + "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & + "00.020.nc" + endif - end subroutine netcdf4_nldas20fileb +end subroutine netcdf4_nldas20fileb diff --git a/lis/metforcing/nldas-2.0/get_nldas20.F90 b/lis/metforcing/nldas-2.0/get_nldas20.F90 index aa16c2c5f..cc43a5ecb 100644 --- a/lis/metforcing/nldas-2.0/get_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/get_nldas20.F90 @@ -16,19 +16,19 @@ ! (derived from get_nldas2.F90) ! ! !INTERFACE: - subroutine get_nldas20(n,findex) +subroutine get_nldas20(n,findex) ! !USES: - use LIS_coreMod, only : LIS_rc - use LIS_timeMgrMod, only : LIS_tick - use LIS_metforcingMod, only : LIS_forc - use LIS_logMod, only : LIS_logunit,LIS_endrun - use nldas20_forcingMod, only : nldas20_struc - use LIS_constantsMod, only : LIS_CONST_PATH_LEN + use LIS_coreMod, only : LIS_rc + use LIS_timeMgrMod, only : LIS_tick + use LIS_metforcingMod, only : LIS_forc + use LIS_logMod, only : LIS_logunit,LIS_endrun + use nldas20_forcingMod, only : nldas20_struc + use LIS_constantsMod, only : LIS_CONST_PATH_LEN - implicit none + implicit none ! !ARGUMENTS: - integer, intent(in) :: n - integer, intent(in) :: findex + integer, intent(in) :: n + integer, intent(in) :: findex ! ! !DESCRIPTION: ! Opens, reads, and interpolates hourly, NLDAS-2 forcing (NARR based). @@ -59,216 +59,216 @@ subroutine get_nldas20(n,findex) ! \end{description} ! !EOP - integer :: c,f,ferrora,ferrorb,ferror,try - integer :: order - integer :: readbfile - real*8 :: time1,time2,timenow - real*8 :: dtime1, dtime2 - integer :: yr1,mo1,da1,hr1,mn1,ss1,doy1 - integer :: yr2,mo2,da2,hr2,mn2,ss2,doy2 - character(len=LIS_CONST_PATH_LEN) :: name_a,name_b - real :: gmt1,gmt2,ts1,ts2 - integer :: movetime ! 1=move time 2 data into time 1 - integer :: kk ! Forecast member index + integer :: c,f,ferrora,ferrorb,ferror,try + integer :: order + integer :: readbfile + real*8 :: time1,time2,timenow + real*8 :: dtime1, dtime2 + integer :: yr1,mo1,da1,hr1,mn1,ss1,doy1 + integer :: yr2,mo2,da2,hr2,mn2,ss2,doy2 + character(len=LIS_CONST_PATH_LEN) :: name_a,name_b + real :: gmt1,gmt2,ts1,ts2 + integer :: movetime ! 1=move time 2 data into time 1 + integer :: kk ! Forecast member index + + external :: netcdf4_nldas20filea + external :: read_nldas20a + external :: netcdf4_nldas20fileb + external :: read_nldas20b - external :: netcdf4_nldas20filea - external :: read_nldas20a - external :: netcdf4_nldas20fileb - external :: read_nldas20b - !=== End Variable Definition =========================================== - try = -999 + try = -999 !=== Check to see if b-file needs to be opened - readbfile = 0 - if ((nldas20_struc(n)%model_level_data.gt.0).or. & - (nldas20_struc(n)%model_dswrf_data.gt.0).or. & - (nldas20_struc(n)%model_level_press.gt.0).or. & - (nldas20_struc(n)%model_pcp_data.gt.0)) then - readbfile = 1 - endif + readbfile = 0 + if ((nldas20_struc(n)%model_level_data.gt.0).or. & + (nldas20_struc(n)%model_dswrf_data.gt.0).or. & + (nldas20_struc(n)%model_level_press.gt.0).or. & + (nldas20_struc(n)%model_pcp_data.gt.0)) then + readbfile = 1 + endif !=== Assumption will be not to find or move any data - nldas20_struc(n)%findtime1 = 0 - nldas20_struc(n)%findtime2 = 0 - movetime = 0 + nldas20_struc(n)%findtime1 = 0 + nldas20_struc(n)%findtime2 = 0 + movetime = 0 !=== Determine Required NLDAS-2 Data Times (The previous hour and the future hour) - yr1 = LIS_rc%yr - mo1 = LIS_rc%mo - da1 = LIS_rc%da - hr1 = LIS_rc%hr - mn1 = LIS_rc%mn - ss1 = 0 - ts1 = 0 - call LIS_tick(timenow,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + yr1 = LIS_rc%yr + mo1 = LIS_rc%mo + da1 = LIS_rc%da + hr1 = LIS_rc%hr + mn1 = LIS_rc%mn + ss1 = 0 + ts1 = 0 + call LIS_tick(timenow,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) - if (LIS_rc%ts.gt.3600) then - write(LIS_logunit,*) & - "[ERR] The model timestep is > forcing data timestep" - write(LIS_logunit,*) & - "[ERR] LIS does not support this mode currently" - write(LIS_logunit,*) "[ERR] Program stopping ..." - call LIS_endrun() - endif + if (LIS_rc%ts.gt.3600) then + write(LIS_logunit,*) & + "[ERR] The model timestep is > forcing data timestep" + write(LIS_logunit,*) & + "[ERR] LIS does not support this mode currently" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif - if (mod(nint(LIS_rc%ts),3600).eq.0) then - if (timenow.ge.nldas20_struc(n)%nldas20time2) then - yr1 = LIS_rc%yr - mo1 = LIS_rc%mo - da1 = LIS_rc%da - hr1 = LIS_rc%hr - mn1 = 0 - ss1 = 0 - ts1 = -60*60 !previous hour - call LIS_tick(time1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + if (mod(nint(LIS_rc%ts),3600).eq.0) then + if (timenow.ge.nldas20_struc(n)%nldas20time2) then + yr1 = LIS_rc%yr + mo1 = LIS_rc%mo + da1 = LIS_rc%da + hr1 = LIS_rc%hr + mn1 = 0 + ss1 = 0 + ts1 = -60*60 !previous hour + call LIS_tick(time1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) - yr2 = LIS_rc%yr - mo2 = LIS_rc%mo - da2 = LIS_rc%da - hr2 = LIS_rc%hr - mn2 = 0 - ss2 = 0 - ts2 = 0 !current hour - call LIS_tick(time2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) - movetime = 1 - nldas20_struc(n)%findtime2 = 1 - endif - else - if (timenow.ge.nldas20_struc(n)%nldas20time2) then - yr1 = LIS_rc%yr - mo1 = LIS_rc%mo - da1 = LIS_rc%da - hr1 = LIS_rc%hr - mn1 = 0 - ss1 = 0 - ts1 = 0 !current hour - call LIS_tick(time1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + yr2 = LIS_rc%yr + mo2 = LIS_rc%mo + da2 = LIS_rc%da + hr2 = LIS_rc%hr + mn2 = 0 + ss2 = 0 + ts2 = 0 !current hour + call LIS_tick(time2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) + movetime = 1 + nldas20_struc(n)%findtime2 = 1 + endif + else + if (timenow.ge.nldas20_struc(n)%nldas20time2) then + yr1 = LIS_rc%yr + mo1 = LIS_rc%mo + da1 = LIS_rc%da + hr1 = LIS_rc%hr + mn1 = 0 + ss1 = 0 + ts1 = 0 !current hour + call LIS_tick(time1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) - yr2 = LIS_rc%yr - mo2 = LIS_rc%mo - da2 = LIS_rc%da - hr2 = LIS_rc%hr - mn2 = 0 - ss2 = 0 - ts2 = 60*60 !next hour - call LIS_tick(time2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) + yr2 = LIS_rc%yr + mo2 = LIS_rc%mo + da2 = LIS_rc%da + hr2 = LIS_rc%hr + mn2 = 0 + ss2 = 0 + ts2 = 60*60 !next hour + call LIS_tick(time2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) - movetime = 1 - nldas20_struc(n)%findtime2 = 1 - endif - endif + movetime = 1 + nldas20_struc(n)%findtime2 = 1 + endif + endif ! Beginning of the run - if ((LIS_rc%tscount(n).eq.1).or.(LIS_rc%rstflag(n).eq.1)) then - nldas20_struc(n)%findtime1 = 1 - nldas20_struc(n)%findtime2 = 1 - movetime = 0 - LIS_rc%rstflag(n) = 0 - endif + if ((LIS_rc%tscount(n).eq.1).or.(LIS_rc%rstflag(n).eq.1)) then + nldas20_struc(n)%findtime1 = 1 + nldas20_struc(n)%findtime2 = 1 + movetime = 0 + LIS_rc%rstflag(n) = 0 + endif - if (movetime.eq.1) then - nldas20_struc(n)%nldas20time1 = nldas20_struc(n)%nldas20time2 - do f = 1,LIS_rc%met_nf(findex) - do c = 1,LIS_rc%ngrid(n) - nldas20_struc(n)%metdata1(:,f,c) = & - nldas20_struc(n)%metdata2(:,f,c) - enddo - enddo - endif !end of movetime=1 + if (movetime.eq.1) then + nldas20_struc(n)%nldas20time1 = nldas20_struc(n)%nldas20time2 + do f = 1,LIS_rc%met_nf(findex) + do c = 1,LIS_rc%ngrid(n) + nldas20_struc(n)%metdata1(:,f,c) = & + nldas20_struc(n)%metdata2(:,f,c) + enddo + enddo + endif !end of movetime=1 ! The following looks back 10 days, at the same hour to fill data gaps. - if (nldas20_struc(n)%findtime1.eq.1) then - ferrora = 0 - ferrorb = 0 - ferror = 0 - try = 0 - ts1 = -60*60*24 - do - if (ferror.ne.0) exit - try = try + 1 + if (nldas20_struc(n)%findtime1.eq.1) then + ferrora = 0 + ferrorb = 0 + ferror = 0 + try = 0 + ts1 = -60*60*24 + do + if (ferror.ne.0) exit + try = try + 1 !- Obtaining NLDAS-2 File-A: - do kk = nldas20_struc(n)%st_iterid,nldas20_struc(n)%en_iterid - call netcdf4_nldas20filea(n,kk,findex,name_a, & - nldas20_struc(n)%nldas20foradir,yr1,mo1,da1,doy1,hr1) - write(unit=LIS_logunit,fmt=*) & - "[INFO] getting file1a.. ",trim(name_a) - order = 1 - call read_nldas20a(n,kk,findex,order,mo1,name_a,ferrora) - enddo + do kk = nldas20_struc(n)%st_iterid,nldas20_struc(n)%en_iterid + call netcdf4_nldas20filea(n,kk,findex,name_a, & + nldas20_struc(n)%nldas20foradir,yr1,mo1,da1,doy1,hr1) + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file1a.. ",trim(name_a) + order = 1 + call read_nldas20a(n,kk,findex,order,mo1,name_a,ferrora) + enddo - if (readbfile.gt.0) then - do kk = nldas20_struc(n)%st_iterid, nldas20_struc(n)%en_iterid - call netcdf4_nldas20fileb(n,kk,findex,name_b, & + if (readbfile.gt.0) then + do kk = nldas20_struc(n)%st_iterid, nldas20_struc(n)%en_iterid + call netcdf4_nldas20fileb(n,kk,findex,name_b, & nldas20_struc(n)%nldas20forbdir,yr1,mo1,da1,doy1,hr1) - write(unit=LIS_logunit,fmt=*) & - "[INFO] getting file1b.. ",trim(name_b) - call read_nldas20b(n,kk,findex,order,name_b,ferrorb) - enddo - else - ferrorb = 1 - endif + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file1b.. ",trim(name_b) + call read_nldas20b(n,kk,findex,order,name_b,ferrorb) + enddo + else + ferrorb = 1 + endif - ferror = ferrora + ferrorb - if (ferror.ge.1) nldas20_struc(n)%nldas20time1 = time1 - call LIS_tick(dtime1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) - if (try.gt.11) then - write(LIS_logunit,*) & - "[ERR] NLDAS-2 data gap exceeds 10 days on file 1" - write(LIS_logunit,*) "[ERR] Program stopping ..." - call LIS_endrun() - endif - enddo + ferror = ferrora + ferrorb + if (ferror.ge.1) nldas20_struc(n)%nldas20time1 = time1 + call LIS_tick(dtime1,doy1,gmt1,yr1,mo1,da1,hr1,mn1,ss1,ts1) + if (try.gt.11) then + write(LIS_logunit,*) & + "[ERR] NLDAS-2 data gap exceeds 10 days on file 1" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + enddo !=== end of data search - endif !end of LIS_rc%findtime=1 + endif !end of LIS_rc%findtime=1 - if (nldas20_struc(n)%findtime2.eq.1) then + if (nldas20_struc(n)%findtime2.eq.1) then ! The following looks back 10 days, at the same hour to fill data gaps. - ferrora = 0 - ferrorb = 0 - ferror = 0 - try = 0 - ts2 = -60*60*24 - do - if (ferror.ne.0) exit - try = try+1 + ferrora = 0 + ferrorb = 0 + ferror = 0 + try = 0 + ts2 = -60*60*24 + do + if (ferror.ne.0) exit + try = try+1 !- Obtaining NLDAS-2 File-A: - do kk = nldas20_struc(n)%st_iterid,nldas20_struc(n)%en_iterid - call netcdf4_nldas20filea(n,kk,findex,name_a, & - nldas20_struc(n)%nldas20foradir,yr2,mo2,da2,doy2,hr2) - write(unit=LIS_logunit,fmt=*) & - "[INFO] getting file2a.. ",trim(name_a) - order = 2 - call read_nldas20a(n,kk,findex,order,mo2,name_a,ferrora) - enddo + do kk = nldas20_struc(n)%st_iterid,nldas20_struc(n)%en_iterid + call netcdf4_nldas20filea(n,kk,findex,name_a, & + nldas20_struc(n)%nldas20foradir,yr2,mo2,da2,doy2,hr2) + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file2a.. ",trim(name_a) + order = 2 + call read_nldas20a(n,kk,findex,order,mo2,name_a,ferrora) + enddo - if (readbfile.gt.0) then - do kk = nldas20_struc(n)%st_iterid, nldas20_struc(n)%en_iterid - call netcdf4_nldas20fileb(n,kk,findex,name_b, & + if (readbfile.gt.0) then + do kk = nldas20_struc(n)%st_iterid, nldas20_struc(n)%en_iterid + call netcdf4_nldas20fileb(n,kk,findex,name_b, & nldas20_struc(n)%nldas20forbdir,yr2,mo2,da2,doy2,hr2) - write(unit=LIS_logunit,fmt=*) & - "[INFO] getting file2b.. ",trim(name_b) - call read_nldas20b(n,kk,findex,order,name_b,ferrorb) - enddo - else - ferrorb = 1 - endif + write(unit=LIS_logunit,fmt=*) & + "[INFO] getting file2b.. ",trim(name_b) + call read_nldas20b(n,kk,findex,order,name_b,ferrorb) + enddo + else + ferrorb = 1 + endif - ferror = ferrora + ferrorb - if (ferror.ge.1) then - nldas20_struc(n)%nldas20time2 = time2 - endif - call LIS_tick(dtime2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) - if (try.gt.11) then - write(LIS_logunit,*) & - "[ERR] NLDAS-2 data gap exceeds 10 days on file 2" - write(LIS_logunit,*) "[ERR] Program stopping ..." - call LIS_endrun() - endif - enddo + ferror = ferrora + ferrorb + if (ferror.ge.1) then + nldas20_struc(n)%nldas20time2 = time2 + endif + call LIS_tick(dtime2,doy2,gmt2,yr2,mo2,da2,hr2,mn2,ss2,ts2) + if (try.gt.11) then + write(LIS_logunit,*) & + "[ERR] NLDAS-2 data gap exceeds 10 days on file 2" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + enddo !=== end of data search - endif ! end of findtime2=1 + endif ! end of findtime2=1 - end subroutine get_nldas20 +end subroutine get_nldas20 diff --git a/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 b/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 index 3365ef0b6..7fd653bf8 100644 --- a/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 +++ b/lis/metforcing/nldas-2.0/nldas20_ec_removal.F90 @@ -16,18 +16,18 @@ ! (derived from nldas2_ec_removal.F90) ! ! !INTERFACE: - subroutine nldas20_ec_removal(nest,point,force_tmp,force_hum, & - force_lwd,force_prs) +subroutine nldas20_ec_removal(nest,point,force_tmp,force_hum, & + force_lwd,force_prs) ! !USES: - use LIS_coreMod, only : LIS_rc - use nldas20_forcingMod, only : nldas20_struc + use LIS_coreMod, only : LIS_rc + use nldas20_forcingMod, only : nldas20_struc - implicit none + implicit none ! !ARGUMENTS: - integer, intent(in) :: nest - integer, intent(in) :: point - real, intent(inout) :: force_tmp,force_hum - real, intent(inout) :: force_lwd,force_prs + integer, intent(in) :: nest + integer, intent(in) :: point + real, intent(inout) :: force_tmp,force_hum + real, intent(inout) :: force_lwd,force_prs ! ! !DESCRIPTION: ! Removes Temperature, Pressure, Humidity and Longwave Radiation @@ -57,63 +57,63 @@ subroutine nldas20_ec_removal(nest,point,force_tmp,force_hum, & ! \end{description} ! !EOP - real :: orig_tmp, orig_hum - real :: orig_lwd, orig_prs - real :: elevdiff - real :: mee, mfe, ee, fe, ratio - real :: esat,qsat,rh_corr,fesat,fqsat,femiss,emiss - real :: tbar - integer, parameter :: bb = 2016 - real, parameter :: grav = 9.81 - real, parameter :: rdry = 287. - real, parameter :: lapse = -0.0065 + real :: orig_tmp, orig_hum + real :: orig_lwd, orig_prs + real :: elevdiff + real :: mee, mfe, ee, fe, ratio + real :: esat,qsat,rh_corr,fesat,fqsat,femiss,emiss + real :: tbar + integer, parameter :: bb = 2016 + real, parameter :: grav = 9.81 + real, parameter :: rdry = 287. + real, parameter :: lapse = -0.0065 ! ---------------------------------------------------------------- - elevdiff = nldas20_struc(nest)%orig_ediff(point) + elevdiff = nldas20_struc(nest)%orig_ediff(point) ! -- Apply elevation correction to temperature: - orig_tmp = force_tmp - (lapse*elevdiff) - tbar = (orig_tmp + force_tmp) / 2.0 + orig_tmp = force_tmp - (lapse*elevdiff) + tbar = (orig_tmp + force_tmp) / 2.0 ! -- Apply elevation correction to surface pressure: - orig_prs = force_prs * (exp((grav*elevdiff)/(rdry*tbar))) + orig_prs = force_prs * (exp((grav*elevdiff)/(rdry*tbar))) ! -- Apply elevation correction to humidity: - if (force_hum.eq.0) force_hum = 1e-08 + if (force_hum.eq.0) force_hum = 1e-08 - esat = 611.2*(exp((17.67*(orig_tmp-273.15)) / & - ((orig_tmp-273.15)+243.5))) - qsat = (0.622*esat) / (orig_prs-(0.378*esat)) - fesat = 611.2*(exp((17.67*(force_tmp-273.15)) / & - ((force_tmp-273.15)+243.5))) - fqsat = (0.622*fesat) / (force_prs-(0.378*fesat)) - rh_corr = (force_hum / fqsat) * 100.0 - orig_hum = (rh_corr * qsat) / 100.0 + esat = 611.2*(exp((17.67*(orig_tmp-273.15)) / & + ((orig_tmp-273.15)+243.5))) + qsat = (0.622*esat) / (orig_prs-(0.378*esat)) + fesat = 611.2*(exp((17.67*(force_tmp-273.15)) / & + ((force_tmp-273.15)+243.5))) + fqsat = (0.622*fesat) / (force_prs-(0.378*fesat)) + rh_corr = (force_hum / fqsat) * 100.0 + orig_hum = (rh_corr * qsat) / 100.0 ! -- Apply elevation correction to downward LW radiation: - ee = (orig_hum * orig_prs) / 0.622 - fe = (force_hum * force_prs) / 0.622 - mee = ee / 100.0 - mfe = fe / 100.0 + ee = (orig_hum * orig_prs) / 0.622 + fe = (force_hum * force_prs) / 0.622 + mee = ee / 100.0 + mfe = fe / 100.0 !---------------------------------------------------------------------- ! Correct for negative vapor pressure at very low temperatures at ! high latitudes !---------------------------------------------------------------------- - if (mee.le.0) mee = 1e-08 - if (mfe.le.0) mfe = 1e-08 + if (mee.le.0) mee = 1e-08 + if (mfe.le.0) mfe = 1e-08 - emiss = 1.08 * (1.0-exp(-mee**(orig_tmp/bb))) - femiss = 1.08 * (1.0-exp(-mfe**(force_tmp/bb))) - ratio = (femiss*(force_tmp**4)) / (emiss*(orig_tmp**4)) - orig_lwd = force_lwd / ratio + emiss = 1.08 * (1.0-exp(-mee**(orig_tmp/bb))) + femiss = 1.08 * (1.0-exp(-mfe**(force_tmp/bb))) + ratio = (femiss*(force_tmp**4)) / (emiss*(orig_tmp**4)) + orig_lwd = force_lwd / ratio !-- Reassign uncorrected fields to LIS forcing fields:: - force_tmp = orig_tmp - force_hum = orig_hum - force_lwd = orig_lwd - force_prs = orig_prs + force_tmp = orig_tmp + force_hum = orig_hum + force_lwd = orig_lwd + force_prs = orig_prs - end subroutine nldas20_ec_removal +end subroutine nldas20_ec_removal diff --git a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 index e78571d8e..60e5cbd58 100644 --- a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 +++ b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 @@ -7,7 +7,7 @@ ! Administrator of the National Aeronautics and Space Administration. ! All Rights Reserved. !-------------------------END NOTICE -- DO NOT EDIT----------------------- - module nldas20_forcingMod +module nldas20_forcingMod !BOP ! !MODULE: nldas20_forcingMod ! @@ -16,19 +16,19 @@ module nldas20_forcingMod ! (derived from nldas2_forcingMod.F90) ! ! !USES: - use LIS_constantsMod, only : LIS_CONST_PATH_LEN + use LIS_constantsMod, only : LIS_CONST_PATH_LEN - implicit none + implicit none - PRIVATE + PRIVATE !----------------------------------------------------------------------------- ! !PUBLIC MEMBER FUNCTIONS: !----------------------------------------------------------------------------- - public :: init_NLDAS20 !defines the native resolution of the input data + public :: init_NLDAS20 !defines the native resolution of the input data !----------------------------------------------------------------------------- ! !PUBLIC TYPES: !----------------------------------------------------------------------------- - public :: nldas20_struc + public :: nldas20_struc ! ! !DESCRIPTION: ! This module contains variables and data structures that are used @@ -81,62 +81,62 @@ module nldas20_forcingMod ! \end{description} ! !EOP - type, public :: nldas20_type_dec - real :: ts - integer :: ncold, nrold ! AWIPS 212 dimensions - character(len=LIS_CONST_PATH_LEN) :: nldas20foradir,nldas20forbdir - real*8 :: nldas20time1,nldas20time2 - integer :: model_level_data - integer :: model_level_press - integer :: model_pcp_data - integer :: model_dswrf_data - - real, allocatable :: orig_ediff(:) - real :: gridDesc(50) - integer :: mi - integer, allocatable :: n111(:) - integer, allocatable :: n121(:) - integer, allocatable :: n211(:) - integer, allocatable :: n221(:) - real, allocatable :: w111(:),w121(:) - real, allocatable :: w211(:),w221(:) - integer, allocatable :: n112(:,:) - integer, allocatable :: n122(:,:) - integer, allocatable :: n212(:,:) - integer, allocatable :: n222(:,:) - real, allocatable :: w112(:,:),w122(:,:) - real, allocatable :: w212(:,:),w222(:,:) - integer, allocatable :: n113(:) - - integer :: findtime1, findtime2 - integer :: nIter, st_iterid,en_iterid ! Forecast parameters - - real, allocatable :: metdata1(:,:,:) - real, allocatable :: metdata2(:,:,:) - - end type nldas20_type_dec - - type(nldas20_type_dec), allocatable :: nldas20_struc(:) - - contains + type, public :: nldas20_type_dec + real :: ts + integer :: ncold, nrold ! AWIPS 212 dimensions + character(len=LIS_CONST_PATH_LEN) :: nldas20foradir,nldas20forbdir + real*8 :: nldas20time1,nldas20time2 + integer :: model_level_data + integer :: model_level_press + integer :: model_pcp_data + integer :: model_dswrf_data + + real, allocatable :: orig_ediff(:) + real :: gridDesc(50) + integer :: mi + integer, allocatable :: n111(:) + integer, allocatable :: n121(:) + integer, allocatable :: n211(:) + integer, allocatable :: n221(:) + real, allocatable :: w111(:),w121(:) + real, allocatable :: w211(:),w221(:) + integer, allocatable :: n112(:,:) + integer, allocatable :: n122(:,:) + integer, allocatable :: n212(:,:) + integer, allocatable :: n222(:,:) + real, allocatable :: w112(:,:),w122(:,:) + real, allocatable :: w212(:,:),w222(:,:) + integer, allocatable :: n113(:) + + integer :: findtime1, findtime2 + integer :: nIter, st_iterid,en_iterid ! Forecast parameters + + real, allocatable :: metdata1(:,:,:) + real, allocatable :: metdata2(:,:,:) + + end type nldas20_type_dec + + type(nldas20_type_dec), allocatable :: nldas20_struc(:) + +contains !BOP ! ! !ROUTINE: init_NLDAS20 ! \label{init_NLDAS20} ! ! !INTERFACE: - subroutine init_NLDAS20(findex) + subroutine init_NLDAS20(findex) ! !USES: - use LIS_coreMod, only : LIS_rc - use LIS_timeMgrMod, only : LIS_update_timestep - use LIS_logMod, only : LIS_logunit,LIS_endrun - use map_utils, only : proj_latlon - use LIS_spatialDownscalingMod, only : LIS_init_pcpclimo_native - use LIS_forecastMod - - implicit none + use LIS_coreMod, only : LIS_rc + use LIS_timeMgrMod, only : LIS_update_timestep + use LIS_logMod, only : LIS_logunit,LIS_endrun + use map_utils, only : proj_latlon + use LIS_spatialDownscalingMod, only : LIS_init_pcpclimo_native + use LIS_forecastMod + + implicit none ! !ARGUMENTS: - integer, intent(in) :: findex + integer, intent(in) :: findex ! ! !DESCRIPTION: ! Defines the native resolution of the input forcing for NLDAS-2 @@ -158,187 +158,187 @@ subroutine init_NLDAS20(findex) ! \end{description} ! !EOP - integer :: n + integer :: n - external :: readcrd_nldas20 - external :: bilinear_interp_input - external :: conserv_interp_input - external :: neighbor_interp_input - external :: read_orig_nldas20_elevdiff - external :: read_nldas20_elev + external :: readcrd_nldas20 + external :: bilinear_interp_input + external :: conserv_interp_input + external :: neighbor_interp_input + external :: read_orig_nldas20_elevdiff + external :: read_nldas20_elev - allocate(nldas20_struc(LIS_rc%nnest)) - call readcrd_nldas20() + allocate(nldas20_struc(LIS_rc%nnest)) + call readcrd_nldas20() - do n = 1,LIS_rc%nnest - nldas20_struc(n)%ts = 3600 - call LIS_update_timestep(LIS_rc,n,nldas20_struc(n)%ts) - enddo + do n = 1,LIS_rc%nnest + nldas20_struc(n)%ts = 3600 + call LIS_update_timestep(LIS_rc,n,nldas20_struc(n)%ts) + enddo - LIS_rc%met_nf(findex) = 13 + LIS_rc%met_nf(findex) = 13 ! Set NLDAS-2 grid dimensions and extent information: - nldas20_struc(:)%ncold = 464 - nldas20_struc(:)%nrold = 224 + nldas20_struc(:)%ncold = 464 + nldas20_struc(:)%nrold = 224 - do n = 1,LIS_rc%nnest + do n = 1,LIS_rc%nnest ! Forecast mode: - if (LIS_rc%forecastMode.eq.1) then - if (mod(LIS_rc%nensem(n), & - LIS_forecast_struc(1)%niterations).ne.0) then - write(LIS_logunit,*) & - "[ERR] The number of ensembles must be a multiple" - write(LIS_logunit,*) & - "[ERR] of the number of iterations" - write(LIS_logunit,*) & - "[ERR] nensem = ",LIS_rc%nensem(n) - write(LIS_logunit,*) & - "[ERR] niter = ",LIS_forecast_struc(1)%niterations - call LIS_endrun() - endif - - allocate(nldas20_struc(n)%metdata1( & - LIS_forecast_struc(1)%niterations, & - LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) - allocate(nldas20_struc(n)%metdata2( & - LIS_forecast_struc(1)%niterations,& - LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) - - nldas20_struc(n)%st_iterid = LIS_forecast_struc(1)%st_iterId - nldas20_struc(n)%en_iterId = LIS_forecast_struc(1)%niterations - nldas20_struc(n)%nIter = LIS_forecast_struc(1)%niterations + if (LIS_rc%forecastMode.eq.1) then + if (mod(LIS_rc%nensem(n), & + LIS_forecast_struc(1)%niterations).ne.0) then + write(LIS_logunit,*) & + "[ERR] The number of ensembles must be a multiple" + write(LIS_logunit,*) & + "[ERR] of the number of iterations" + write(LIS_logunit,*) & + "[ERR] nensem = ",LIS_rc%nensem(n) + write(LIS_logunit,*) & + "[ERR] niter = ",LIS_forecast_struc(1)%niterations + call LIS_endrun() + endif + + allocate(nldas20_struc(n)%metdata1( & + LIS_forecast_struc(1)%niterations, & + LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) + allocate(nldas20_struc(n)%metdata2( & + LIS_forecast_struc(1)%niterations,& + LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) + + nldas20_struc(n)%st_iterid = LIS_forecast_struc(1)%st_iterId + nldas20_struc(n)%en_iterId = LIS_forecast_struc(1)%niterations + nldas20_struc(n)%nIter = LIS_forecast_struc(1)%niterations ! Regular retrospective or non-forecast mode: - else - allocate(nldas20_struc(n)%metdata1(1,LIS_rc%met_nf(findex),& - LIS_rc%ngrid(n))) - allocate(nldas20_struc(n)%metdata2(1,LIS_rc%met_nf(findex),& - LIS_rc%ngrid(n))) - - nldas20_struc(n)%st_iterid = 1 - nldas20_struc(n)%en_iterId = 1 - nldas20_struc(n)%nIter = 1 - endif - - nldas20_struc(n)%metdata1 = 0 - nldas20_struc(n)%metdata2 = 0 - nldas20_struc(n)%gridDesc = 0 - nldas20_struc(n)%findtime1 = 0 - nldas20_struc(n)%findtime2 = 0 - nldas20_struc(n)%gridDesc(1) = 0 - nldas20_struc(n)%gridDesc(2) = nldas20_struc(n)%ncold - nldas20_struc(n)%gridDesc(3) = nldas20_struc(n)%nrold - nldas20_struc(n)%gridDesc(4) = 25.0625 - nldas20_struc(n)%gridDesc(5) = -124.9375 - nldas20_struc(n)%gridDesc(6) = 128 - nldas20_struc(n)%gridDesc(7) = 52.9375 - nldas20_struc(n)%gridDesc(8) = -67.0625 - nldas20_struc(n)%gridDesc(9) = 0.125 - nldas20_struc(n)%gridDesc(10) = 0.125 - nldas20_struc(n)%gridDesc(20) = 64 + else + allocate(nldas20_struc(n)%metdata1(1,LIS_rc%met_nf(findex),& + LIS_rc%ngrid(n))) + allocate(nldas20_struc(n)%metdata2(1,LIS_rc%met_nf(findex),& + LIS_rc%ngrid(n))) + + nldas20_struc(n)%st_iterid = 1 + nldas20_struc(n)%en_iterId = 1 + nldas20_struc(n)%nIter = 1 + endif + + nldas20_struc(n)%metdata1 = 0 + nldas20_struc(n)%metdata2 = 0 + nldas20_struc(n)%gridDesc = 0 + nldas20_struc(n)%findtime1 = 0 + nldas20_struc(n)%findtime2 = 0 + nldas20_struc(n)%gridDesc(1) = 0 + nldas20_struc(n)%gridDesc(2) = nldas20_struc(n)%ncold + nldas20_struc(n)%gridDesc(3) = nldas20_struc(n)%nrold + nldas20_struc(n)%gridDesc(4) = 25.0625 + nldas20_struc(n)%gridDesc(5) = -124.9375 + nldas20_struc(n)%gridDesc(6) = 128 + nldas20_struc(n)%gridDesc(7) = 52.9375 + nldas20_struc(n)%gridDesc(8) = -67.0625 + nldas20_struc(n)%gridDesc(9) = 0.125 + nldas20_struc(n)%gridDesc(10) = 0.125 + nldas20_struc(n)%gridDesc(20) = 64 ! Check for grid and interp option selected: - if ((nldas20_struc(n)%gridDesc(9).eq.LIS_rc%gridDesc(n,9)).and.& - (nldas20_struc(n)%gridDesc(10).eq.LIS_rc%gridDesc(n,10)).and.& - (LIS_rc%gridDesc(n,1).eq.proj_latlon).and. & - (LIS_rc%met_interp(findex).ne."neighbor")) then - write(LIS_logunit,*) & - "[ERR] The NLDAS grid was selected for the LIS run domain;" - write(LIS_logunit,*) & - "[ERR] however, 'bilinear', 'budget-bilinear', or some" - write(LIS_logunit,*) & - "[ERR] other unknown option was selected to spatially" - write(LIS_logunit,*) & - "[ERR] downscale the grid, which will cause errors" - write(LIS_logunit,*) & - "[ERR] during runtime. Please select 'neighbor'." - write(LIS_logunit,*) "[ERR] Program stopping ..." - call LIS_endrun() - endif - - nldas20_struc(n)%mi = nldas20_struc(n)%ncold*nldas20_struc(n)%nrold + if ((nldas20_struc(n)%gridDesc(9).eq.LIS_rc%gridDesc(n,9)).and.& + (nldas20_struc(n)%gridDesc(10).eq.LIS_rc%gridDesc(n,10)).and.& + (LIS_rc%gridDesc(n,1).eq.proj_latlon).and. & + (LIS_rc%met_interp(findex).ne."neighbor")) then + write(LIS_logunit,*) & + "[ERR] The NLDAS grid was selected for the LIS run domain;" + write(LIS_logunit,*) & + "[ERR] however, 'bilinear', 'budget-bilinear', or some" + write(LIS_logunit,*) & + "[ERR] other unknown option was selected to spatially" + write(LIS_logunit,*) & + "[ERR] downscale the grid, which will cause errors" + write(LIS_logunit,*) & + "[ERR] during runtime. Please select 'neighbor'." + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + + nldas20_struc(n)%mi = nldas20_struc(n)%ncold*nldas20_struc(n)%nrold ! Setting up weights for spatial interpolation: - select case(LIS_rc%met_interp(findex)) - - case ("bilinear") - allocate(nldas20_struc(n)%n111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%n121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%n211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%n221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - - call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & - nldas20_struc(n)%n111,nldas20_struc(n)%n121, & - nldas20_struc(n)%n211,nldas20_struc(n)%n221, & - nldas20_struc(n)%w111,nldas20_struc(n)%w121, & - nldas20_struc(n)%w211,nldas20_struc(n)%w221) - - case ("budget-bilinear") - allocate(nldas20_struc(n)%n111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%n121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%n211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%n221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - - call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & - nldas20_struc(n)%n111,nldas20_struc(n)%n121, & - nldas20_struc(n)%n211,nldas20_struc(n)%n221, & - nldas20_struc(n)%w111,nldas20_struc(n)%w121, & - nldas20_struc(n)%w211,nldas20_struc(n)%w221) - - allocate(nldas20_struc(n)%n112(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - allocate(nldas20_struc(n)%n122(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - allocate(nldas20_struc(n)%n212(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - allocate(nldas20_struc(n)%n222(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - allocate(nldas20_struc(n)%w112(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - allocate(nldas20_struc(n)%w122(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - allocate(nldas20_struc(n)%w212(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - allocate(nldas20_struc(n)%w222(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) - - call conserv_interp_input(n,nldas20_struc(n)%gridDesc(:), & - nldas20_struc(n)%n112,nldas20_struc(n)%n122, & - nldas20_struc(n)%n212,nldas20_struc(n)%n222, & - nldas20_struc(n)%w112,nldas20_struc(n)%w122, & - nldas20_struc(n)%w212,nldas20_struc(n)%w222) - - case ("neighbor") - allocate(nldas20_struc(n)%n113(LIS_rc%lnc(n)*LIS_rc%lnr(n))) - call neighbor_interp_input(n,nldas20_struc(n)%gridDesc(:), & - nldas20_struc(n)%n113) - - case default - write(LIS_logunit,*) & - "[ERR] Interpolation option not specified for NLDAS-2" - write(LIS_logunit,*) "[ERR] Program stopping ..." - call LIS_endrun() - end select + select case(LIS_rc%met_interp(findex)) + + case ("bilinear") + allocate(nldas20_struc(n)%n111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + + call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221) + + case ("budget-bilinear") + allocate(nldas20_struc(n)%n111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%n221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w111(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w121(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w211(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + + call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221) + + allocate(nldas20_struc(n)%n112(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%n122(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%n212(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%n222(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w112(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w122(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w212(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + allocate(nldas20_struc(n)%w222(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) + + call conserv_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n112,nldas20_struc(n)%n122, & + nldas20_struc(n)%n212,nldas20_struc(n)%n222, & + nldas20_struc(n)%w112,nldas20_struc(n)%w122, & + nldas20_struc(n)%w212,nldas20_struc(n)%w222) + + case ("neighbor") + allocate(nldas20_struc(n)%n113(LIS_rc%lnc(n)*LIS_rc%lnr(n))) + call neighbor_interp_input(n,nldas20_struc(n)%gridDesc(:), & + nldas20_struc(n)%n113) + + case default + write(LIS_logunit,*) & + "[ERR] Interpolation option not specified for NLDAS-2" + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + end select ! Read in elevation difference and NLDAS-2 elevation maps: - if (LIS_rc%met_ecor(findex).ne."none") then - allocate(nldas20_struc(n)%orig_ediff( & - nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) - call read_orig_nldas20_elevdiff(n) - call read_nldas20_elev(n,findex) - endif + if (LIS_rc%met_ecor(findex).ne."none") then + allocate(nldas20_struc(n)%orig_ediff( & + nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + call read_orig_nldas20_elevdiff(n) + call read_nldas20_elev(n,findex) + endif ! Set up precipitation climate downscaling: - if (LIS_rc%pcp_downscale(findex).ne.0) then - call LIS_init_pcpclimo_native(n,findex, & - nint(nldas20_struc(n)%gridDesc(2)), & - nint(nldas20_struc(n)%gridDesc(3))) - endif - enddo + if (LIS_rc%pcp_downscale(findex).ne.0) then + call LIS_init_pcpclimo_native(n,findex, & + nint(nldas20_struc(n)%gridDesc(2)), & + nint(nldas20_struc(n)%gridDesc(3))) + endif + enddo - end subroutine init_NLDAS20 + end subroutine init_NLDAS20 - end module nldas20_forcingMod +end module nldas20_forcingMod diff --git a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 index 4ff4ea7f2..25fc7b1cc 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 @@ -17,21 +17,21 @@ ! (derived from read_nldas2_elev.F90) ! ! !INTERFACE: - subroutine read_nldas20_elev(n,findex) +subroutine read_nldas20_elev(n,findex) ! !USES: - use LIS_coreMod - use LIS_metforcingMod - use LIS_logMod - use nldas20_forcingMod - use LIS_fileIOMod + use LIS_coreMod + use LIS_metforcingMod + use LIS_logMod + use nldas20_forcingMod + use LIS_fileIOMod #if (defined USE_NETCDF3 || defined USE_NETCDF4) - use netcdf + use netcdf #endif - implicit none + implicit none ! !ARGUMENTS: - integer, intent(in) :: n - integer, intent(in) :: findex + integer, intent(in) :: n + integer, intent(in) :: findex ! ! !DESCRIPTION: ! @@ -52,44 +52,44 @@ subroutine read_nldas20_elev(n,findex) ! \end{description} ! !EOP - logical :: file_exists - integer :: nid,elevId - integer :: c,r - real :: elev(LIS_rc%gnc(n),LIS_rc%gnr(n)) - real :: elev_subset(LIS_rc%lnc(n),LIS_rc%lnr(n)) + logical :: file_exists + integer :: nid,elevId + integer :: c,r + real :: elev(LIS_rc%gnc(n),LIS_rc%gnr(n)) + real :: elev_subset(LIS_rc%lnc(n),LIS_rc%lnr(n)) #if (defined USE_NETCDF3 || defined USE_NETCDF4) - inquire(file=LIS_rc%paramfile(n),exist=file_exists) - if (file_exists) then - write(LIS_logunit,*) & - "[INFO] Reading NLDAS-2 elevation data ... " + inquire(file=LIS_rc%paramfile(n),exist=file_exists) + if (file_exists) then + write(LIS_logunit,*) & + "[INFO] Reading NLDAS-2 elevation data ... " - call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & - mode=NF90_NOWRITE,ncid=nid), & - "nf90_open failed in read_nldas20_elev") - call LIS_verify(nf90_inq_varid(nid,"ELEV_NLDAS2",elevId), & - "nf90_inq_varid failed in read_nldas20_elev") - call LIS_verify(nf90_get_var(nid,elevId,elev), & - "nf90_get_var failed in read_nldas20_elev") - call LIS_verify(nf90_close(nid)) + call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & + mode=NF90_NOWRITE,ncid=nid), & + "nf90_open failed in read_nldas20_elev") + call LIS_verify(nf90_inq_varid(nid,"ELEV_NLDAS2",elevId), & + "nf90_inq_varid failed in read_nldas20_elev") + call LIS_verify(nf90_get_var(nid,elevId,elev), & + "nf90_get_var failed in read_nldas20_elev") + call LIS_verify(nf90_close(nid)) - elev_subset(:,:) = elev(LIS_ews_halo_ind(n,LIS_localPet+1): & - LIS_ewe_halo_ind(n,LIS_localPet+1), & - LIS_nss_halo_ind(n,LIS_localPet+1): & - LIS_nse_halo_ind(n,LIS_localPet+1)) + elev_subset(:,:) = elev(LIS_ews_halo_ind(n,LIS_localPet+1): & + LIS_ewe_halo_ind(n,LIS_localPet+1), & + LIS_nss_halo_ind(n,LIS_localPet+1): & + LIS_nse_halo_ind(n,LIS_localPet+1)) - do r = 1,LIS_rc%lnr(n) - do c = 1,LIS_rc%lnc(n) - if (LIS_domain(n)%gindex(c,r).ne.-1) then - LIS_forc(n,findex)%modelelev(LIS_domain(n)%gindex(c,r)) = elev_subset(c,r) - endif - enddo - enddo - endif + do r = 1,LIS_rc%lnr(n) + do c = 1,LIS_rc%lnc(n) + if (LIS_domain(n)%gindex(c,r).ne.-1) then + LIS_forc(n,findex)%modelelev(LIS_domain(n)%gindex(c,r)) = elev_subset(c,r) + endif + enddo + enddo + endif - write(LIS_logunit,*) & - "[INFO] Finished reading original NLDAS-2 elevation data" + write(LIS_logunit,*) & + "[INFO] Finished reading original NLDAS-2 elevation data" #endif - end subroutine read_nldas20_elev +end subroutine read_nldas20_elev diff --git a/lis/metforcing/nldas-2.0/read_nldas20a.F90 b/lis/metforcing/nldas-2.0/read_nldas20a.F90 index 5d7c3f433..159edf858 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20a.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20a.F90 @@ -17,25 +17,25 @@ ! (derived from read_nldas2a.F90) ! ! !INTERFACE: - subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) +subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) ! !USES: - use LIS_coreMod - use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_warning - use LIS_metforcingMod, only : LIS_forc - use nldas20_forcingMod, only : nldas20_struc + use LIS_coreMod + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_warning + use LIS_metforcingMod, only : LIS_forc + use nldas20_forcingMod, only : nldas20_struc #if (defined USE_NETCDF3 || defined USE_NETCDF4) - use netcdf + use netcdf #endif - implicit none + implicit none ! !ARGUMENTS: - integer, intent(in) :: n - integer, intent(in) :: kk ! Forecast member index - integer, intent(in) :: findex ! Forcing index - integer, intent(in) :: order - integer, intent(out) :: month - character(len=*), intent(in) :: name - integer, intent(out) :: ferror + integer, intent(in) :: n + integer, intent(in) :: kk ! Forecast member index + integer, intent(in) :: findex ! Forcing index + integer, intent(in) :: order + integer, intent(out) :: month + character(len=*), intent(in) :: name + integer, intent(out) :: ferror ! ! !DESCRIPTION: ! For the given time, reads values from NLDAS-2 netCDF-4 FORA data, @@ -67,130 +67,130 @@ subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) ! \end{description} ! !EOP - integer :: iv,ftn - integer :: nldas20,paramid - integer :: k,t,c,r,iret,rc - real, parameter :: missingValue = -9999.0 - integer, parameter :: nvars = 11 - logical :: pcp_flag - logical :: file_exists - character(len=20) :: input_varname(nvars) - logical*1, allocatable :: lb(:) - real, allocatable :: f(:) - real, allocatable :: nldas20_forcing(:,:) - real :: varfield(LIS_rc%lnc(n),LIS_rc%lnr(n)) - real :: dummy(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) - - ferror = 1 - iv = 0 - - input_varname(1) = "Tair" - input_varname(2) = "Qair" - input_varname(3) = "SWdown" - input_varname(4) = "LWdown" - input_varname(5) = "Wind_E" - input_varname(6) = "Wind_N" - input_varname(7) = "PSurf" - input_varname(8) = "Rainf" - input_varname(9) = "CRainf_frac" - input_varname(10) = "PotEvap" - input_varname(11) = "CAPE" + integer :: iv,ftn + integer :: nldas20,paramid + integer :: k,t,c,r,iret,rc + real, parameter :: missingValue = -9999.0 + integer, parameter :: nvars = 11 + logical :: pcp_flag + logical :: file_exists + character(len=20) :: input_varname(nvars) + logical*1, allocatable :: lb(:) + real, allocatable :: f(:) + real, allocatable :: nldas20_forcing(:,:) + real :: varfield(LIS_rc%lnc(n),LIS_rc%lnr(n)) + real :: dummy(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) + + ferror = 1 + iv = 0 + + input_varname(1) = "Tair" + input_varname(2) = "Qair" + input_varname(3) = "SWdown" + input_varname(4) = "LWdown" + input_varname(5) = "Wind_E" + input_varname(6) = "Wind_N" + input_varname(7) = "PSurf" + input_varname(8) = "Rainf" + input_varname(9) = "CRainf_frac" + input_varname(10) = "PotEvap" + input_varname(11) = "CAPE" #if (defined USE_NETCDF3 || defined USE_NETCDF4) - nldas20 = (nldas20_struc(n)%ncold*nldas20_struc(n)%nrold) - - allocate(nldas20_forcing(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold,nvars)) - - varfield = 0 - ferror = 1 - - inquire(file=name,exist=file_exists) - if (file_exists) then - iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) - if (iret.ne.0) then - write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) - ferror = 0 - return - endif - - allocate(lb(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) - allocate(f(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) - - do k = 1,nvars - iret = nf90_inq_varid(ftn,trim(input_varname(k)),paramid) - call LIS_verify(iret,trim(input_varname(k))// & - " field not found in the hourly file") - iret = nf90_get_var(ftn,paramid,dummy) - call LIS_verify(iret,"Error in nf90_get_var") - -! write(LIS_logunit,*) "[INFO] Read field: ",input_varname(k) - - f = LIS_rc%udef ! Initialize forcing - t = 0 - do r = 1,nldas20_struc(n)%nrold - do c = 1,nldas20_struc(n)%ncold - t = t + 1 - f(t) = dummy(c,r) - enddo - enddo - - lb = .false. - do t = 1,nldas20 - if (f(t).ne.missingValue) then - nldas20_forcing(t,k) = f(t) - lb(t) = .true. - else - nldas20_forcing(t,k) = LIS_rc%udef - endif - enddo - enddo - deallocate(f) - - iret = nf90_close(ftn) - - if (LIS_rc%met_ecor(findex).ne."none") then - do t = 1,nldas20 - if (lb(t)) then - call nldas20_ec_removal(n,t,nldas20_forcing(t,1), & - nldas20_forcing(t,2),nldas20_forcing(t,4), & - nldas20_forcing(t,7)) - endif - enddo - endif - - do iv = 1,nvars - pcp_flag = .false. - if ((iv.eq.8).or.(iv.eq.9)) pcp_flag = .true. - - call interp_nldas20(n,findex,month,pcp_flag,nldas20, & - nldas20_forcing(:,iv), & - lb,LIS_rc%gridDesc(n,:), & - LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) - - do r = 1,LIS_rc%lnr(n) - do c = 1,LIS_rc%lnc(n) - if (LIS_domain(n)%gindex(c,r).ne.-1) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,iv, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,iv, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - enddo - enddo - enddo - deallocate(lb) - else - write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) - ferror = 0 - endif - - deallocate(nldas20_forcing) + nldas20 = (nldas20_struc(n)%ncold*nldas20_struc(n)%nrold) + + allocate(nldas20_forcing(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold,nvars)) + + varfield = 0 + ferror = 1 + + inquire(file=name,exist=file_exists) + if (file_exists) then + iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) + if (iret.ne.0) then + write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) + ferror = 0 + return + endif + + allocate(lb(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + allocate(f(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + + do k = 1,nvars + iret = nf90_inq_varid(ftn,trim(input_varname(k)),paramid) + call LIS_verify(iret,trim(input_varname(k))// & + " field not found in the hourly file") + iret = nf90_get_var(ftn,paramid,dummy) + call LIS_verify(iret,"Error in nf90_get_var") + + ! write(LIS_logunit,*) "[INFO] Read field: ",input_varname(k) + + f = LIS_rc%udef ! Initialize forcing + t = 0 + do r = 1,nldas20_struc(n)%nrold + do c = 1,nldas20_struc(n)%ncold + t = t + 1 + f(t) = dummy(c,r) + enddo + enddo + + lb = .false. + do t = 1,nldas20 + if (f(t).ne.missingValue) then + nldas20_forcing(t,k) = f(t) + lb(t) = .true. + else + nldas20_forcing(t,k) = LIS_rc%udef + endif + enddo + enddo + deallocate(f) + + iret = nf90_close(ftn) + + if (LIS_rc%met_ecor(findex).ne."none") then + do t = 1,nldas20 + if (lb(t)) then + call nldas20_ec_removal(n,t,nldas20_forcing(t,1), & + nldas20_forcing(t,2),nldas20_forcing(t,4), & + nldas20_forcing(t,7)) + endif + enddo + endif + + do iv = 1,nvars + pcp_flag = .false. + if ((iv.eq.8).or.(iv.eq.9)) pcp_flag = .true. + + call interp_nldas20(n,findex,month,pcp_flag,nldas20, & + nldas20_forcing(:,iv), & + lb,LIS_rc%gridDesc(n,:), & + LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) + + do r = 1,LIS_rc%lnr(n) + do c = 1,LIS_rc%lnc(n) + if (LIS_domain(n)%gindex(c,r).ne.-1) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,iv, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,iv, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + enddo + enddo + enddo + deallocate(lb) + else + write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) + ferror = 0 + endif + + deallocate(nldas20_forcing) #endif - end subroutine read_nldas20a +end subroutine read_nldas20a !BOP ! !ROUTINE: interp_nldas20 @@ -201,26 +201,26 @@ end subroutine read_nldas20a ! (derived from read_nldas2a.F90) ! ! !INTERFACE: - subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & - input_data,input_bitmap,lis_gds,nc,nr,output_2d) +subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & + input_data,input_bitmap,lis_gds,nc,nr,output_2d) ! !USES: - use LIS_coreMod, only : LIS_rc,LIS_domain - use nldas20_forcingMod, only : nldas20_struc - use LIS_spatialDownscalingMod + use LIS_coreMod, only : LIS_rc,LIS_domain + use nldas20_forcingMod, only : nldas20_struc + use LIS_spatialDownscalingMod - implicit none + implicit none ! !ARGUMENTS: - integer, intent(in) :: n - integer, intent(in) :: findex - integer, intent(in) :: month - logical, intent(in) :: pcp_flag - integer, intent(in) :: input_size - real, intent(in) :: input_data(input_size) - logical*1, intent(in) :: input_bitmap(input_size) - real, intent(in) :: lis_gds(50) - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: output_2d(nc,nr) + integer, intent(in) :: n + integer, intent(in) :: findex + integer, intent(in) :: month + logical, intent(in) :: pcp_flag + integer, intent(in) :: input_size + real, intent(in) :: input_data(input_size) + logical*1, intent(in) :: input_bitmap(input_size) + real, intent(in) :: lis_gds(50) + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: output_2d(nc,nr) ! ! !DESCRIPTION: ! This subroutine interpolates a given NLDAS-2 field to the LIS grid. @@ -259,19 +259,19 @@ subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & ! \end{description} ! !EOP - integer :: iret - integer :: mo - integer :: count1,i,j - real, dimension(nc*nr) :: output_data - logical*1 :: output_bitmap(nc*nr) + integer :: iret + integer :: mo + integer :: count1,i,j + real, dimension(nc*nr) :: output_data + logical*1 :: output_bitmap(nc*nr) !=== End variable declarations - mo = nc*nr + mo = nc*nr !----------------------------------------------------------------------- ! Initialize output bitmap. !----------------------------------------------------------------------- - output_bitmap = .true. + output_bitmap = .true. !----------------------------------------------------------------------- ! Apply downscaling @@ -282,76 +282,76 @@ subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & ! if LIS_rc%pcp_downscale(findex).eq.2: spatial downscaling and bias-correction using ratios of two ! PCP climatologies which are calculated in LDT and stored in lis input file - if (pcp_flag) then - if (LIS_rc%pcp_downscale(findex).eq.1) then + if (pcp_flag) then + if (LIS_rc%pcp_downscale(findex).eq.1) then !input_data becomes the ratio field. - call LIS_generatePcpClimoRatioField(n,findex,"NLDAS2", & - month,input_size,input_data,input_bitmap) - elseif (pcp_flag.and.(LIS_rc%pcp_downscale(findex).eq.2)) then - call LIS_readPcpClimoRatioField(n,findex,month) - endif - endif + call LIS_generatePcpClimoRatioField(n,findex,"NLDAS2", & + month,input_size,input_data,input_bitmap) + elseif (pcp_flag.and.(LIS_rc%pcp_downscale(findex).eq.2)) then + call LIS_readPcpClimoRatioField(n,findex,month) + endif + endif !----------------------------------------------------------------------- ! Interpolate to LIS grid !----------------------------------------------------------------------- - select case(LIS_rc%met_interp(findex)) - - case("bilinear") - call bilinear_interp(lis_gds,input_bitmap,input_data, & - output_bitmap,output_data,nldas20_struc(n)%mi,mo, & - LIS_domain(n)%lat,LIS_domain(n)%lon, & - nldas20_struc(n)%w111,nldas20_struc(n)%w121, & - nldas20_struc(n)%w211,nldas20_struc(n)%w221, & - nldas20_struc(n)%n111,nldas20_struc(n)%n121, & - nldas20_struc(n)%n211,nldas20_struc(n)%n221, & - LIS_rc%udef,iret) - - case("budget-bilinear") - if (pcp_flag) then - call conserv_interp(lis_gds,input_bitmap,input_data, & - output_bitmap,output_data,nldas20_struc(n)%mi,mo, & - LIS_domain(n)%lat,LIS_domain(n)%lon, & - nldas20_struc(n)%w112,nldas20_struc(n)%w122, & - nldas20_struc(n)%w212,nldas20_struc(n)%w222, & - nldas20_struc(n)%n112,nldas20_struc(n)%n122, & - nldas20_struc(n)%n212,nldas20_struc(n)%n222, & - LIS_rc%udef,iret) - - else - call bilinear_interp(lis_gds,input_bitmap,input_data, & - output_bitmap,output_data,nldas20_struc(n)%mi,mo, & - LIS_domain(n)%lat,LIS_domain(n)%lon, & - nldas20_struc(n)%w111,nldas20_struc(n)%w121, & - nldas20_struc(n)%w211,nldas20_struc(n)%w221, & - nldas20_struc(n)%n111,nldas20_struc(n)%n121, & - nldas20_struc(n)%n211,nldas20_struc(n)%n221, & - LIS_rc%udef,iret) - endif - - case("neighbor") - call neighbor_interp(lis_gds,input_bitmap,input_data, & - output_bitmap,output_data,nldas20_struc(n)%mi,mo, & - LIS_domain(n)%lat,LIS_domain(n)%lon, & - nldas20_struc(n)%n113,LIS_rc%udef,iret) - - end select - - if (pcp_flag.and.(LIS_rc%pcp_downscale(findex).ne.0)) then - call LIS_pcpClimoDownscaling(n,findex,month,nc*nr, & - output_data,output_bitmap) - endif + select case(LIS_rc%met_interp(findex)) + + case("bilinear") + call bilinear_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221, & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + LIS_rc%udef,iret) + + case("budget-bilinear") + if (pcp_flag) then + call conserv_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%w112,nldas20_struc(n)%w122, & + nldas20_struc(n)%w212,nldas20_struc(n)%w222, & + nldas20_struc(n)%n112,nldas20_struc(n)%n122, & + nldas20_struc(n)%n212,nldas20_struc(n)%n222, & + LIS_rc%udef,iret) + + else + call bilinear_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%w211,nldas20_struc(n)%w221, & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + LIS_rc%udef,iret) + endif + + case("neighbor") + call neighbor_interp(lis_gds,input_bitmap,input_data, & + output_bitmap,output_data,nldas20_struc(n)%mi,mo, & + LIS_domain(n)%lat,LIS_domain(n)%lon, & + nldas20_struc(n)%n113,LIS_rc%udef,iret) + + end select + + if (pcp_flag.and.(LIS_rc%pcp_downscale(findex).ne.0)) then + call LIS_pcpClimoDownscaling(n,findex,month,nc*nr, & + output_data,output_bitmap) + endif !----------------------------------------------------------------------- ! convert the interpolated data to 2d. !----------------------------------------------------------------------- - count1 = 0 - do j = 1,nr - do i = 1,nc - output_2d(i,j) = output_data(i+count1) - enddo - count1 = count1 + nc - enddo - - end subroutine interp_nldas20 + count1 = 0 + do j = 1,nr + do i = 1,nc + output_2d(i,j) = output_data(i+count1) + enddo + count1 = count1 + nc + enddo + +end subroutine interp_nldas20 diff --git a/lis/metforcing/nldas-2.0/read_nldas20b.F90 b/lis/metforcing/nldas-2.0/read_nldas20b.F90 index faf8c3f23..a1cc53eb8 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20b.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20b.F90 @@ -17,24 +17,24 @@ ! (derived from read_nldas2b.F90) ! ! !INTERFACE: - subroutine read_nldas20b(n,kk,findex,order,name,ferror) +subroutine read_nldas20b(n,kk,findex,order,name,ferror) ! !USES: - use LIS_coreMod, only : LIS_rc,LIS_domain - use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_warning - use LIS_metforcingMod, only : LIS_forc - use nldas20_forcingMod, only : nldas20_struc + use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_warning + use LIS_metforcingMod, only : LIS_forc + use nldas20_forcingMod, only : nldas20_struc #if (defined USE_NETCDF3 || defined USE_NETCDF4) - use netcdf + use netcdf #endif - implicit none + implicit none ! !ARGUMENTS: - integer, intent(in) :: n - integer, intent(in) :: kk ! Forecast member index - integer, intent(in) :: findex ! Forcing index - integer, intent(in) :: order - character(len=*), intent(in) :: name - integer, intent(out) :: ferror + integer, intent(in) :: n + integer, intent(in) :: kk ! Forecast member index + integer, intent(in) :: findex ! Forcing index + integer, intent(in) :: order + character(len=*), intent(in) :: name + integer, intent(out) :: ferror ! ! !DESCRIPTION: ! For the given time, reads values from NLDAS-2 netCDF-4 FORB data, @@ -64,241 +64,240 @@ subroutine read_nldas20b(n,kk,findex,order,name,ferror) ! \end{description} ! !EOP - integer :: iv,ftn - integer :: nldas20,paramid - integer :: k,t,c,r,iret,rc - real, parameter :: missingValue = -9999.0 - integer, parameter :: nvars = 10 - logical :: pcp_flag - logical :: file_exists - character(len=20) :: input_varname(nvars) - logical*1, allocatable :: lb(:) - real, allocatable :: f(:) - real, allocatable :: nldas20_forcing(:,:) - real :: varfield(LIS_rc%lnc(n),LIS_rc%lnr(n)) - real :: dummy(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) + integer :: iv,ftn + integer :: nldas20,paramid + integer :: k,t,c,r,iret,rc + real, parameter :: missingValue = -9999.0 + integer, parameter :: nvars = 10 + logical :: pcp_flag + logical :: file_exists + character(len=20) :: input_varname(nvars) + logical*1, allocatable :: lb(:) + real, allocatable :: f(:) + real, allocatable :: nldas20_forcing(:,:) + real :: varfield(LIS_rc%lnc(n),LIS_rc%lnr(n)) + real :: dummy(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) - ferror = 1 - iv = 0 + ferror = 1 + iv = 0 - input_varname(1) = "SWdown" - input_varname(2) = "Rainf" - input_varname(3) = "CRainf" - input_varname(4) = "ACond" - input_varname(5) = "Tair" - input_varname(6) = "Qair" - input_varname(7) = "PSurf" - input_varname(8) = "Wind_E" - input_varname(9) = "Wind_N" - input_varname(10) = "PhiS" + input_varname(1) = "SWdown" + input_varname(2) = "Rainf" + input_varname(3) = "CRainf" + input_varname(4) = "ACond" + input_varname(5) = "Tair" + input_varname(6) = "Qair" + input_varname(7) = "PSurf" + input_varname(8) = "Wind_E" + input_varname(9) = "Wind_N" + input_varname(10) = "PhiS" #if (defined USE_NETCDF3 || defined USE_NETCDF4) - nldas20 = (nldas20_struc(n)%ncold*nldas20_struc(n)%nrold) + nldas20 = (nldas20_struc(n)%ncold*nldas20_struc(n)%nrold) - allocate(nldas20_forcing(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold,nvars)) + allocate(nldas20_forcing(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold,nvars)) - varfield = 0 - ferror = 1 + varfield = 0 + ferror = 1 - inquire(file=name,exist=file_exists) - if (file_exists) then - iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) - if (iret.ne.0) then - write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) - ferror = 0 - return - endif + inquire(file=name,exist=file_exists) + if (file_exists) then + iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) + if (iret.ne.0) then + write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) + ferror = 0 + return + endif - allocate(lb(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) - allocate(f(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + allocate(lb(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) + allocate(f(nldas20_struc(n)%ncold*nldas20_struc(n)%nrold)) - do k = 1,nvars - iret = nf90_inq_varid(ftn,trim(input_varname(k)),paramid) - call LIS_verify(iret,trim(input_varname(k))// & - " field not found in the hourly file") - iret = nf90_get_var(ftn,paramid,dummy) - call LIS_verify(iret,"Error in nf90_get_var") + do k = 1,nvars + iret = nf90_inq_varid(ftn,trim(input_varname(k)),paramid) + call LIS_verify(iret,trim(input_varname(k))// & + " field not found in the hourly file") + iret = nf90_get_var(ftn,paramid,dummy) + call LIS_verify(iret,"Error in nf90_get_var") + ! write(LIS_logunit,*) "[INFO] Read field: ",input_varname(k) -! write(LIS_logunit,*) "[INFO] Read field: ",input_varname(k) + f = LIS_rc%udef ! Initialize forcing + t = 0 + do r = 1,nldas20_struc(n)%nrold + do c = 1,nldas20_struc(n)%ncold + t = t + 1 + f(t) = dummy(c,r) + enddo + enddo - f = LIS_rc%udef ! Initialize forcing - t = 0 - do r = 1,nldas20_struc(n)%nrold - do c = 1,nldas20_struc(n)%ncold - t = t + 1 - f(t) = dummy(c,r) - enddo - enddo + lb = .false. + do t = 1,nldas20 + if (f(t).ne.missingValue) then + nldas20_forcing(t,k) = f(t) + lb(t) = .true. + else + nldas20_forcing(t,k) = LIS_rc%udef + endif + enddo + enddo + deallocate(f) - lb = .false. - do t = 1,nldas20 - if (f(t).ne.missingValue) then - nldas20_forcing(t,k) = f(t) - lb(t) = .true. - else - nldas20_forcing(t,k) = LIS_rc%udef - endif - enddo - enddo - deallocate(f) + iret = nf90_close(ftn) - iret = nf90_close(ftn) + do iv = 1,nvars + pcp_flag = .false. + if ((iv.eq.2).or.(iv.eq.3)) pcp_flag = .true. - do iv = 1,nvars - pcp_flag = .false. - if ((iv.eq.2).or.(iv.eq.3)) pcp_flag = .true. + call interp_nldas20(n,findex,LIS_rc%mo,pcp_flag,nldas20, & + nldas20_forcing(:,iv), & + lb,LIS_rc%gridDesc(n,:), & + LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) - call interp_nldas20(n,findex,LIS_rc%mo,pcp_flag,nldas20, & - nldas20_forcing(:,iv), & - lb,LIS_rc%gridDesc(n,:), & - LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) - - do r = 1,LIS_rc%lnr(n) - do c = 1,LIS_rc%lnc(n) - if (LIS_domain(n)%gindex(c,r).ne.-1) then + do r = 1,LIS_rc%lnr(n) + do c = 1,LIS_rc%lnc(n) + if (LIS_domain(n)%gindex(c,r).ne.-1) then ! MODEL LEVEL TAIR CASE - if (iv.eq.5) then - if (nldas20_struc(n)%model_level_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,1, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,1, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.5) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,1, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,1, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL LEVEL SPFH CASE - if (iv.eq.6) then - if (nldas20_struc(n)%model_level_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,2, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,2, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.6) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,2, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,2, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! USE MODEL BASED DSWRF CASE - if (iv.eq.1) then - if (nldas20_struc(n)%model_dswrf_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,3, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,3, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.1) then + if (nldas20_struc(n)%model_dswrf_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,3, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,3, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL LEVEL USE AERODYNAMIC CONDUCTANCE - if (iv.eq.4) then - if (nldas20_struc(n)%model_level_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,13, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,13, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.4) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,13, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,13, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL LEVEL UWIND CASE - if (iv.eq.8) then - if (nldas20_struc(n)%model_level_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,5, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,5, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.8) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,5, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,5, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL LEVEL VWIND CASE - if (iv.eq.9) then - if (nldas20_struc(n)%model_level_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,6, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,6, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.9) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,6, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,6, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL LEVEL PRESSURE CASE - if (iv.eq.7) then - if (nldas20_struc(n)%model_level_press.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,7, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,7, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.7) then + if (nldas20_struc(n)%model_level_press.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,7, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,7, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL BASED PRECIP CASE - if (iv.eq.2) then - if (nldas20_struc(n)%model_pcp_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,8, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,8, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.2) then + if (nldas20_struc(n)%model_pcp_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,8, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,8, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL BASED CONV. PRECIP CASE - if (iv.eq.3) then - if (nldas20_struc(n)%model_pcp_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,9, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,9, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif + if (iv.eq.3) then + if (nldas20_struc(n)%model_pcp_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,9, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,9, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif ! MODEL FORCING HEIGHT CASE - if (iv.eq.10) then - if (nldas20_struc(n)%model_level_data.gt.0) then - if (order.eq.1) then - nldas20_struc(n)%metdata1(kk,12, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - elseif (order.eq.2) then - nldas20_struc(n)%metdata2(kk,12, & - LIS_domain(n)%gindex(c,r)) = varfield(c,r) - endif - endif - endif - - endif - enddo - enddo - enddo - deallocate(lb) - else - write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) - ferror = 0 - endif + if (iv.eq.10) then + if (nldas20_struc(n)%model_level_data.gt.0) then + if (order.eq.1) then + nldas20_struc(n)%metdata1(kk,12, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + elseif (order.eq.2) then + nldas20_struc(n)%metdata2(kk,12, & + LIS_domain(n)%gindex(c,r)) = varfield(c,r) + endif + endif + endif + + endif + enddo + enddo + enddo + deallocate(lb) + else + write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) + ferror = 0 + endif - deallocate(nldas20_forcing) + deallocate(nldas20_forcing) #endif - end subroutine read_nldas20b +end subroutine read_nldas20b diff --git a/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 index 811ad974d..44b99987d 100644 --- a/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 +++ b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 @@ -17,18 +17,18 @@ ! (derived from read_orig_nldas2_elevdiff.F90) ! ! !INTERFACE: - subroutine read_orig_nldas20_elevdiff(n) +subroutine read_orig_nldas20_elevdiff(n) ! !USES: - use LIS_coreMod - use nldas20_forcingMod, only : nldas20_struc - use LIS_logmod + use LIS_coreMod + use nldas20_forcingMod, only : nldas20_struc + use LIS_logmod #if (defined USE_NETCDF3 || defined USE_NETCDF4) - use netcdf + use netcdf #endif - implicit none + implicit none ! !ARGUMENTS: - integer, intent(in) :: n + integer, intent(in) :: n ! ! !DESCRIPTION: ! Open and read in original NLDAS elevation difference file. @@ -40,39 +40,39 @@ subroutine read_orig_nldas20_elevdiff(n) ! \end{description} ! !EOP - integer :: i, err - logical :: file_exists - integer :: nid,elevId - integer :: c,r - real :: elevdiff(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) + integer :: i, err + logical :: file_exists + integer :: nid,elevId + integer :: c,r + real :: elevdiff(nldas20_struc(n)%ncold,nldas20_struc(n)%nrold) #if (defined USE_NETCDF3 || defined USE_NETCDF4) - inquire(file=LIS_rc%paramfile(n),exist=file_exists) + inquire(file=LIS_rc%paramfile(n),exist=file_exists) - if (file_exists) then - write(LIS_logunit,*) & - "[INFO] Reading NLDAS-2 original elevation difference file ..." + if (file_exists) then + write(LIS_logunit,*) & + "[INFO] Reading NLDAS-2 original elevation difference file ..." - call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & - mode=NF90_NOWRITE,ncid=nid), & - "nf90_open failed in read_orig_nldas20_elevdiff") - call LIS_verify(nf90_inq_varid(nid,"ELEVDIFF_NLDAS2",elevId), & - "nf90_inq_varid failed in read_orig_nldas20_elevdiff") - call LIS_verify(nf90_get_var(nid,elevId,elevdiff), & - "nf90_get_var failed in read_orig_nldas20_elevdiff") - call LIS_verify(nf90_close(nid)) + call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & + mode=NF90_NOWRITE,ncid=nid), & + "nf90_open failed in read_orig_nldas20_elevdiff") + call LIS_verify(nf90_inq_varid(nid,"ELEVDIFF_NLDAS2",elevId), & + "nf90_inq_varid failed in read_orig_nldas20_elevdiff") + call LIS_verify(nf90_get_var(nid,elevId,elevdiff), & + "nf90_get_var failed in read_orig_nldas20_elevdiff") + call LIS_verify(nf90_close(nid)) - do r = 1,nldas20_struc(n)%nrold - do c = 1,nldas20_struc(n)%ncold - nldas20_struc(n)%orig_ediff(c+(r-1)*nldas20_struc(n)%ncold) = elevdiff(c,r) - enddo - enddo - endif + do r = 1,nldas20_struc(n)%nrold + do c = 1,nldas20_struc(n)%ncold + nldas20_struc(n)%orig_ediff(c+(r-1)*nldas20_struc(n)%ncold) = elevdiff(c,r) + enddo + enddo + endif - write(LIS_logunit,*) "[INFO] Finished reading original NLDAS-2" - write(LIS_logunit,*) "[INFO] elevation difference data." + write(LIS_logunit,*) "[INFO] Finished reading original NLDAS-2" + write(LIS_logunit,*) "[INFO] elevation difference data." #endif - end subroutine read_orig_nldas20_elevdiff +end subroutine read_orig_nldas20_elevdiff diff --git a/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 index d0b04e88e..46fb5e33b 100644 --- a/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 @@ -17,101 +17,101 @@ ! (derived from readcrd_nldas2.F90) ! ! !INTERFACE: - subroutine readcrd_nldas20() +subroutine readcrd_nldas20() ! !USES: - use ESMF - use LIS_coreMod, only : LIS_rc,LIS_config - use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_endrun - use nldas20_forcingMod, only : nldas20_struc + use ESMF + use LIS_coreMod, only : LIS_rc,LIS_config + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_endrun + use nldas20_forcingMod, only : nldas20_struc - implicit none + implicit none ! ! !DESCRIPTION: ! This routine reads the options specific to NLDAS-2 forcing from ! the LIS configuration file. ! !EOP - integer :: n,rc + integer :: n,rc - do n = 1,LIS_rc%nnest - nldas20_struc(n)%model_level_data = 0 - nldas20_struc(n)%model_level_press = 0 - nldas20_struc(n)%model_pcp_data = 0 - nldas20_struc(n)%model_dswrf_data = 0 - enddo + do n = 1,LIS_rc%nnest + nldas20_struc(n)%model_level_data = 0 + nldas20_struc(n)%model_level_press = 0 + nldas20_struc(n)%model_pcp_data = 0 + nldas20_struc(n)%model_dswrf_data = 0 + enddo - call ESMF_ConfigFindLabel(LIS_config, & - "NLDAS-2.0 FORA forcing directory:",rc=rc) - call LIS_verify(rc, & - "NLDAS-2.0 FORA forcing directory: not defined") - do n = 1,LIS_rc%nnest - call ESMF_ConfigGetAttribute(LIS_config, & - nldas20_struc(n)%nldas20foradir,rc=rc) - enddo + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 FORA forcing directory:",rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 FORA forcing directory: not defined") + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%nldas20foradir,rc=rc) + enddo - call ESMF_ConfigFindLabel(LIS_config, & - "NLDAS-2.0 use FORB model level data:",rc=rc) - do n = 1,LIS_rc%nnest - call ESMF_ConfigGetAttribute(LIS_config, & - nldas20_struc(n)%model_level_data,default=0,rc=rc) - call LIS_verify(rc, & - "NLDAS-2.0 use FORB model level data: is not defined") - enddo + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model level data:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_level_data,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model level data: is not defined") + enddo - call ESMF_ConfigFindLabel(LIS_config, & - "NLDAS-2.0 use FORB model-based SWdown:",rc=rc) - do n = 1,LIS_rc%nnest - call ESMF_ConfigGetAttribute(LIS_config, & - nldas20_struc(n)%model_dswrf_data,default=0,rc=rc) - call LIS_verify(rc, & - "NLDAS-2.0 use FORB model-based SWdown: not defined") - enddo + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model-based SWdown:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_dswrf_data,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model-based SWdown: not defined") + enddo - call ESMF_ConfigFindLabel(LIS_config, & - "NLDAS-2.0 use FORB model-based precip:",rc=rc) - do n = 1,LIS_rc%nnest - call ESMF_ConfigGetAttribute(LIS_config, & - nldas20_struc(n)%model_pcp_data,default=0,rc=rc) - call LIS_verify(rc, & - "NLDAS-2.0 use FORB model-based precip: not defined") - enddo + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model-based precip:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_pcp_data,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model-based precip: not defined") + enddo - call ESMF_ConfigFindLabel(LIS_config, & - "NLDAS-2.0 use FORB model-based pressure:",rc=rc) - do n = 1,LIS_rc%nnest - call ESMF_ConfigGetAttribute(LIS_config, & - nldas20_struc(n)%model_level_press,default=0,rc=rc) - call LIS_verify(rc, & - "NLDAS-2.0 use FORB model-based pressure: not defined") - enddo + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 use FORB model-based pressure:",rc=rc) + do n = 1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%model_level_press,default=0,rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 use FORB model-based pressure: not defined") + enddo - write(unit=LIS_logunit,fmt=*) & - "[INFO] Using NLDAS-2.0 v020 netCDF-4 forcing" + write(unit=LIS_logunit,fmt=*) & + "[INFO] Using NLDAS-2.0 v020 netCDF-4 forcing" - do n = 1,LIS_rc%nnest - write(unit=LIS_logunit,fmt=*) & - "[INFO] NLDAS-2.0 FORA forcing directory: ", & - trim(nldas20_struc(n)%nldas20foradir) - nldas20_struc(n)%ncold = 464 - nldas20_struc(n)%nrold = 224 - nldas20_struc(n)%nldas20time1 = 3000.0 - nldas20_struc(n)%nldas20time2 = 0.0 + do n = 1,LIS_rc%nnest + write(unit=LIS_logunit,fmt=*) & + "[INFO] NLDAS-2.0 FORA forcing directory: ", & + trim(nldas20_struc(n)%nldas20foradir) + nldas20_struc(n)%ncold = 464 + nldas20_struc(n)%nrold = 224 + nldas20_struc(n)%nldas20time1 = 3000.0 + nldas20_struc(n)%nldas20time2 = 0.0 - if ((nldas20_struc(n)%model_level_data.eq.1).or. & - (nldas20_struc(n)%model_dswrf_data.eq.1).or. & - (nldas20_struc(n)%model_pcp_data.eq.1).or. & - (nldas20_struc(n)%model_level_press.eq.1)) then - call ESMF_ConfigFindLabel(LIS_config, & - "NLDAS-2.0 FORB forcing directory:",rc=rc) - call LIS_verify(rc, & - "NLDAS-2.0 FORB forcing directory: not defined") - call ESMF_ConfigGetAttribute(LIS_config, & - nldas20_struc(n)%nldas20forbdir,rc=rc) - write(unit=LIS_logunit,fmt=*) & - "[INFO] NLDAS-2.0 FORB forcing directory: ", & - trim(nldas20_struc(n)%nldas20forbdir) - endif - enddo + if ((nldas20_struc(n)%model_level_data.eq.1).or. & + (nldas20_struc(n)%model_dswrf_data.eq.1).or. & + (nldas20_struc(n)%model_pcp_data.eq.1).or. & + (nldas20_struc(n)%model_level_press.eq.1)) then + call ESMF_ConfigFindLabel(LIS_config, & + "NLDAS-2.0 FORB forcing directory:",rc=rc) + call LIS_verify(rc, & + "NLDAS-2.0 FORB forcing directory: not defined") + call ESMF_ConfigGetAttribute(LIS_config, & + nldas20_struc(n)%nldas20forbdir,rc=rc) + write(unit=LIS_logunit,fmt=*) & + "[INFO] NLDAS-2.0 FORB forcing directory: ", & + trim(nldas20_struc(n)%nldas20forbdir) + endif + enddo - end subroutine readcrd_nldas20 +end subroutine readcrd_nldas20 diff --git a/lis/metforcing/nldas-2.0/reset_nldas20.F90 b/lis/metforcing/nldas-2.0/reset_nldas20.F90 index 1f3b32a2e..bf3fa4add 100644 --- a/lis/metforcing/nldas-2.0/reset_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/reset_nldas20.F90 @@ -16,24 +16,24 @@ ! (derived from reset_nldas2.F90) ! ! !INTERFACE: - subroutine reset_nldas20() +subroutine reset_nldas20() ! !USES: - use LIS_coreMod, only : LIS_rc - use nldas20_forcingMod, only : nldas20_struc + use LIS_coreMod, only : LIS_rc + use nldas20_forcingMod, only : nldas20_struc - implicit none + implicit none ! ! !DESCRIPTION: ! Routine to reset NLDAS-2 forcing related memory allocations. ! !EOP - integer :: n - integer :: findex + integer :: n + integer :: findex - do n = 1,LIS_rc%nnest - nldas20_struc(n)%nldas20time1 = 3000.0 - nldas20_struc(n)%nldas20time2 = 0.0 - enddo + do n = 1,LIS_rc%nnest + nldas20_struc(n)%nldas20time1 = 3000.0 + nldas20_struc(n)%nldas20time2 = 0.0 + enddo - end subroutine reset_nldas20 +end subroutine reset_nldas20 diff --git a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 index 2012874ac..e1be31d31 100644 --- a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 @@ -16,22 +16,22 @@ ! (derived from timeinterp_nldas2.F90) ! ! !INTERFACE: - subroutine timeinterp_nldas20(n,findex) +subroutine timeinterp_nldas20(n,findex) ! !USES: - use ESMF - use LIS_FORC_AttributesMod - use LIS_coreMod, only : LIS_rc,LIS_domain - use LIS_constantsMod, only : LIS_CONST_SOLAR - use LIS_metforcingMod, only : LIS_forc,LIS_FORC_Base_State - use LIS_timeMgrMod, only : LIS_tick,LIS_time2date - use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_endrun - use nldas20_forcingMod, only : nldas20_struc - use LIS_forecastMod, only : LIS_get_iteration_index - - implicit none + use ESMF + use LIS_FORC_AttributesMod + use LIS_coreMod, only : LIS_rc,LIS_domain + use LIS_constantsMod, only : LIS_CONST_SOLAR + use LIS_metforcingMod, only : LIS_forc,LIS_FORC_Base_State + use LIS_timeMgrMod, only : LIS_tick,LIS_time2date + use LIS_logMod, only : LIS_logunit,LIS_verify,LIS_endrun + use nldas20_forcingMod, only : nldas20_struc + use LIS_forecastMod, only : LIS_get_iteration_index + + implicit none ! !ARGUMENTS: - integer, intent(in) :: n - integer, intent(in) :: findex + integer, intent(in) :: n + integer, intent(in) :: findex ! ! !DESCRIPTION: ! Temporally interpolates the forcing data to the current model @@ -52,431 +52,431 @@ subroutine timeinterp_nldas20(n,findex) ! \end{description} ! !EOP - integer :: zdoy - real :: zw1,zw2 - real :: czm,cze,czb - real :: wt1,wt2,swt1,swt2 - real :: gmt1,gmt2,tempbts - integer :: t,index1 - integer :: bdoy,byr,bmo,bda,bhr,bmn - real*8 :: btime,newtime1,newtime2 - real :: tempgmt1,tempgmt2 - integer :: tempbdoy,tempbyr,tempbmo,tempbda,tempbhr,tempbmn - integer :: tempbss - - integer :: status - type(ESMF_Field) :: tmpField,q2Field,uField,vField,swdField,lwdField - type(ESMF_Field) :: psurfField,pcpField,cpcpField,fhgtField,acondField - type(ESMF_Field) :: PETField,CAPEField - real, pointer :: tmp(:),q2(:),uwind(:),vwind(:) - real, pointer :: swd(:),lwd(:),psurf(:),pcp(:),cpcp(:) - real, pointer :: fheight(:),acond(:),pet(:),cape(:) - logical :: forcing_z,forcing_ch,forcing_pet,forcing_cape - integer :: mfactor,m,k,kk + integer :: zdoy + real :: zw1,zw2 + real :: czm,cze,czb + real :: wt1,wt2,swt1,swt2 + real :: gmt1,gmt2,tempbts + integer :: t,index1 + integer :: bdoy,byr,bmo,bda,bhr,bmn + real*8 :: btime,newtime1,newtime2 + real :: tempgmt1,tempgmt2 + integer :: tempbdoy,tempbyr,tempbmo,tempbda,tempbhr,tempbmn + integer :: tempbss + + integer :: status + type(ESMF_Field) :: tmpField,q2Field,uField,vField,swdField,lwdField + type(ESMF_Field) :: psurfField,pcpField,cpcpField,fhgtField,acondField + type(ESMF_Field) :: PETField,CAPEField + real, pointer :: tmp(:),q2(:),uwind(:),vwind(:) + real, pointer :: swd(:),lwd(:),psurf(:),pcp(:),cpcp(:) + real, pointer :: fheight(:),acond(:),pet(:),cape(:) + logical :: forcing_z,forcing_ch,forcing_pet,forcing_cape + integer :: mfactor,m,k,kk !________________________________________ - btime = nldas20_struc(n)%nldas20time1 - call LIS_time2date(btime,bdoy,gmt1,byr,bmo,bda,bhr,bmn) - - tempbdoy = bdoy - tempgmt1 = gmt1 - tempbyr = byr - tempbmo = bmo - tempbda = bda - tempbhr = bhr - if (tempbhr.eq.24) tempbhr = 0 - tempbmn = bmn - tempbss = 0 - tempbts = 0 - call LIS_tick(newtime1,tempbdoy,tempgmt1,tempbyr,tempbmo,tempbda,& - tempbhr,tempbmn,tempbss,tempbts) - - btime = nldas20_struc(n)%nldas20time2 - call LIS_time2date(btime,bdoy,gmt2,byr,bmo,bda,bhr,bmn) - tempbdoy = bdoy - tempgmt2 = gmt2 - tempbyr = byr - tempbmo = bmo - tempbda = bda - tempbhr = bhr - if (tempbhr.eq.24) tempbhr = 0 - tempbmn = bmn - tempbss = 0 - tempbts = 0 - call LIS_tick(newtime2,tempbdoy,tempgmt2,tempbyr,tempbmo,tempbda,& - tempbhr,tempbmn,tempbss,tempbts) + btime = nldas20_struc(n)%nldas20time1 + call LIS_time2date(btime,bdoy,gmt1,byr,bmo,bda,bhr,bmn) + + tempbdoy = bdoy + tempgmt1 = gmt1 + tempbyr = byr + tempbmo = bmo + tempbda = bda + tempbhr = bhr + if (tempbhr.eq.24) tempbhr = 0 + tempbmn = bmn + tempbss = 0 + tempbts = 0 + call LIS_tick(newtime1,tempbdoy,tempgmt1,tempbyr,tempbmo,tempbda,& + tempbhr,tempbmn,tempbss,tempbts) + + btime = nldas20_struc(n)%nldas20time2 + call LIS_time2date(btime,bdoy,gmt2,byr,bmo,bda,bhr,bmn) + tempbdoy = bdoy + tempgmt2 = gmt2 + tempbyr = byr + tempbmo = bmo + tempbda = bda + tempbhr = bhr + if (tempbhr.eq.24) tempbhr = 0 + tempbmn = bmn + tempbss = 0 + tempbts = 0 + call LIS_tick(newtime2,tempbdoy,tempgmt2,tempbyr,tempbmo,tempbda,& + tempbhr,tempbmn,tempbss,tempbts) !=== Interpolate Data in time - wt1 = (nldas20_struc(n)%nldas20time2 - LIS_rc%time) / & - (nldas20_struc(n)%nldas20time2 - nldas20_struc(n)%nldas20time1) - wt2 = 1.0 - wt1 - swt1 = (newtime2 - LIS_rc%time) / (newtime2 - newtime1) - swt2 = 1.0 - swt1 - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Tair%varname(1),tmpField,rc=status) - call LIS_verify(status, & - "Error: Enable Tair in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Qair%varname(1),q2Field,rc=status) - call LIS_verify(status, & - "Error: Enable Qair in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_SWdown%varname(1),swdField,rc=status) - call LIS_verify(status, & - "Error: Enable SWdown in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_LWdown%varname(1),lwdField,rc=status) - call LIS_verify(status, & - "Error: Enable LWdown in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Wind_E%varname(1),uField,rc=status) - call LIS_verify(status, & - "Error: Enable Wind_E in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Wind_N%varname(1),vField,rc=status) - call LIS_verify(status, & - "Error: Enable Wind_N in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Psurf%varname(1),psurfField,rc=status) - call LIS_verify(status, & - "Error: Enable Psurf in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Rainf%varname(1),pcpField,rc=status) - call LIS_verify(status, & - "Error: Enable Rainf in the forcing variables list") - - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_CRainf%varname(1),cpcpField,rc=status) - call LIS_verify(status, & - "Error: Enable CRainf in the forcing variables list") - - forcing_z = .false. - forcing_ch = .false. - if (nldas20_struc(n)%model_level_data.eq.1) then - if (LIS_FORC_Forc_Hgt%selectOpt.eq.1) then - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Forc_Hgt%varname(1),fhgtField,rc=status) - call LIS_verify(status, & - "Error: Enable Forc_Hgt in the forcing variables list") - forcing_z = .true. - else - write(LIS_logunit,*) & - "[ERR] Trying to use the NLDAS-2 FORB forcing data" - write(LIS_logunit,*) & - "[ERR] without turning on Forc_Hgt variable in the" - write(LIS_logunit,*) & - "[ERR] Forcing variable list file. Please turn the" - write(LIS_logunit,*) & - "[ERR] Forc_Hgt variable on when using FORB data." - write(LIS_logunit,*) "[ERR] Program stopping ..." - call LIS_endrun() - endif - - if (LIS_FORC_Ch%selectOpt.eq.1) then - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_Ch%varname(1),acondField,rc=status) - call LIS_verify(status, & - "Error: Enable Ch in the forcing variables list") - forcing_ch = .true. - else - write(LIS_logunit,*) & - "[ERR] Trying to use the NLDAS-2 FORB forcing data" - write(LIS_logunit,*) & - "[ERR] without turning on Ch variable in the" - write(LIS_logunit,*) & - "[ERR] Forcing variable list file. Please turn the" - write(LIS_logunit,*) & - "[ERR] Ch variable on when using FORB data." - write(LIS_logunit,*) "[ERR] Program stopping ..." - call LIS_endrun() - endif - endif - - if (LIS_FORC_PET%selectOpt.eq.1) then - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_PET%varname(1),PETField,rc=status) - call LIS_verify(status, & - "Error: Enable PET in the forcing variables list") - forcing_pet = .true. - else - forcing_pet = .false. - endif - - if (LIS_FORC_CAPE%selectOpt.eq.1) then - call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & - LIS_FORC_CAPE%varname(1),CAPEField,rc=status) - call LIS_verify(status, & - "Error: Enable CAPE in the forcing variables list") - forcing_cape = .true. - else - forcing_cape = .false. - endif - - call ESMF_FieldGet(swdField,localDE=0,farrayPtr=swd,rc=status) - call LIS_verify(status) + wt1 = (nldas20_struc(n)%nldas20time2 - LIS_rc%time) / & + (nldas20_struc(n)%nldas20time2 - nldas20_struc(n)%nldas20time1) + wt2 = 1.0 - wt1 + swt1 = (newtime2 - LIS_rc%time) / (newtime2 - newtime1) + swt2 = 1.0 - swt1 + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Tair%varname(1),tmpField,rc=status) + call LIS_verify(status, & + "Error: Enable Tair in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Qair%varname(1),q2Field,rc=status) + call LIS_verify(status, & + "Error: Enable Qair in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_SWdown%varname(1),swdField,rc=status) + call LIS_verify(status, & + "Error: Enable SWdown in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_LWdown%varname(1),lwdField,rc=status) + call LIS_verify(status, & + "Error: Enable LWdown in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Wind_E%varname(1),uField,rc=status) + call LIS_verify(status, & + "Error: Enable Wind_E in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Wind_N%varname(1),vField,rc=status) + call LIS_verify(status, & + "Error: Enable Wind_N in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Psurf%varname(1),psurfField,rc=status) + call LIS_verify(status, & + "Error: Enable Psurf in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Rainf%varname(1),pcpField,rc=status) + call LIS_verify(status, & + "Error: Enable Rainf in the forcing variables list") + + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_CRainf%varname(1),cpcpField,rc=status) + call LIS_verify(status, & + "Error: Enable CRainf in the forcing variables list") + + forcing_z = .false. + forcing_ch = .false. + if (nldas20_struc(n)%model_level_data.eq.1) then + if (LIS_FORC_Forc_Hgt%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Forc_Hgt%varname(1),fhgtField,rc=status) + call LIS_verify(status, & + "Error: Enable Forc_Hgt in the forcing variables list") + forcing_z = .true. + else + write(LIS_logunit,*) & + "[ERR] Trying to use the NLDAS-2 FORB forcing data" + write(LIS_logunit,*) & + "[ERR] without turning on Forc_Hgt variable in the" + write(LIS_logunit,*) & + "[ERR] Forcing variable list file. Please turn the" + write(LIS_logunit,*) & + "[ERR] Forc_Hgt variable on when using FORB data." + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + + if (LIS_FORC_Ch%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_Ch%varname(1),acondField,rc=status) + call LIS_verify(status, & + "Error: Enable Ch in the forcing variables list") + forcing_ch = .true. + else + write(LIS_logunit,*) & + "[ERR] Trying to use the NLDAS-2 FORB forcing data" + write(LIS_logunit,*) & + "[ERR] without turning on Ch variable in the" + write(LIS_logunit,*) & + "[ERR] Forcing variable list file. Please turn the" + write(LIS_logunit,*) & + "[ERR] Ch variable on when using FORB data." + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun() + endif + endif + + if (LIS_FORC_PET%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_PET%varname(1),PETField,rc=status) + call LIS_verify(status, & + "Error: Enable PET in the forcing variables list") + forcing_pet = .true. + else + forcing_pet = .false. + endif + + if (LIS_FORC_CAPE%selectOpt.eq.1) then + call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & + LIS_FORC_CAPE%varname(1),CAPEField,rc=status) + call LIS_verify(status, & + "Error: Enable CAPE in the forcing variables list") + forcing_cape = .true. + else + forcing_cape = .false. + endif + + call ESMF_FieldGet(swdField,localDE=0,farrayPtr=swd,rc=status) + call LIS_verify(status) ! Loop over number of forcing ensembles: - mfactor = LIS_rc%nensem(n) / nldas20_struc(n)%nIter - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - zdoy = LIS_rc%doy -! Compute and apply zenith angle weights - call zterp(1,LIS_domain(n)%grid(index1)%lat, & - LIS_domain(n)%grid(index1)%lon, & - gmt1,gmt2,LIS_rc%gmt,zdoy,zw1,zw2, & - czb,cze,czm,LIS_rc) - - kk = LIS_get_iteration_index(n,k,index1,mfactor) - - if ((nldas20_struc(n)%metdata1(kk,3,index1).ne.LIS_rc%udef).and. & - (nldas20_struc(n)%metdata2(kk,3,index1).ne.LIS_rc%udef)) then - swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*zw1) + & - (nldas20_struc(n)%metdata2(kk,3,index1)*zw2) -! In cases of small cos(zenith) angles, use linear weighting -! to avoid overly large weights. - if ((swd(t).gt.nldas20_struc(n)%metdata1(kk,3,index1)).and.& - (swd(t).gt.nldas20_struc(n)%metdata2(kk,3,index1)).and.& - ((czb.lt.0.1).or.(cze.lt.0.1))) then - swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*swt1)+ & - (nldas20_struc(n)%metdata2(kk,3,index1)*swt2) - endif - endif - - if (swd(t).gt.LIS_CONST_SOLAR) then - write(unit=LIS_logunit,fmt=*) & - "[WARN] sw radiation too high!!" - write(unit=LIS_logunit,fmt=*) & - "[WARN] it is: ",swd(t) - write(unit=LIS_logunit,fmt=*) & - "[WARN] data1 =",nldas20_struc(n)%metdata1(kk,3,index1) - write(unit=LIS_logunit,fmt=*) & - "[WARN] data2 =",nldas20_struc(n)%metdata2(kk,3,index1) - write(unit=LIS_logunit,fmt=*) & - "[WARN] zw1 =",zw1,"zw2 =",zw2 - write(unit=LIS_logunit,fmt=*) & - "[WARN] swt1 =",swt1,"swt2 =",swt2 - endif - enddo - enddo ! End for SWdown + mfactor = LIS_rc%nensem(n) / nldas20_struc(n)%nIter + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + zdoy = LIS_rc%doy + ! Compute and apply zenith angle weights + call zterp(1,LIS_domain(n)%grid(index1)%lat, & + LIS_domain(n)%grid(index1)%lon, & + gmt1,gmt2,LIS_rc%gmt,zdoy,zw1,zw2, & + czb,cze,czm,LIS_rc) + + kk = LIS_get_iteration_index(n,k,index1,mfactor) + + if ((nldas20_struc(n)%metdata1(kk,3,index1).ne.LIS_rc%udef).and. & + (nldas20_struc(n)%metdata2(kk,3,index1).ne.LIS_rc%udef)) then + swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*zw1) + & + (nldas20_struc(n)%metdata2(kk,3,index1)*zw2) + ! In cases of small cos(zenith) angles, use linear weighting + ! to avoid overly large weights. + if ((swd(t).gt.nldas20_struc(n)%metdata1(kk,3,index1)).and.& + (swd(t).gt.nldas20_struc(n)%metdata2(kk,3,index1)).and.& + ((czb.lt.0.1).or.(cze.lt.0.1))) then + swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*swt1)+ & + (nldas20_struc(n)%metdata2(kk,3,index1)*swt2) + endif + endif + + if (swd(t).gt.LIS_CONST_SOLAR) then + write(unit=LIS_logunit,fmt=*) & + "[WARN] sw radiation too high!!" + write(unit=LIS_logunit,fmt=*) & + "[WARN] it is: ",swd(t) + write(unit=LIS_logunit,fmt=*) & + "[WARN] data1 =",nldas20_struc(n)%metdata1(kk,3,index1) + write(unit=LIS_logunit,fmt=*) & + "[WARN] data2 =",nldas20_struc(n)%metdata2(kk,3,index1) + write(unit=LIS_logunit,fmt=*) & + "[WARN] zw1 =",zw1,"zw2 =",zw2 + write(unit=LIS_logunit,fmt=*) & + "[WARN] swt1 =",swt1,"swt2 =",swt2 + endif + enddo + enddo ! End for SWdown ! Do block precipitation interpolation - call ESMF_FieldGet(pcpField,localDE=0,farrayPtr=pcp,rc=status) - call LIS_verify(status) - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if (nldas20_struc(n)%metdata2(kk,8,index1).ne.LIS_rc%udef) then - pcp(t) = nldas20_struc(n)%metdata2(kk,8,index1) - pcp(t) = pcp(t) / (60.0*60.0) - endif - enddo - enddo - - call ESMF_FieldGet(cpcpField,localDE=0,farrayPtr=cpcp,rc=status) - call LIS_verify(status) + call ESMF_FieldGet(pcpField,localDE=0,farrayPtr=pcp,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if (nldas20_struc(n)%metdata2(kk,8,index1).ne.LIS_rc%udef) then + pcp(t) = nldas20_struc(n)%metdata2(kk,8,index1) + pcp(t) = pcp(t) / (60.0*60.0) + endif + enddo + enddo + + call ESMF_FieldGet(cpcpField,localDE=0,farrayPtr=cpcp,rc=status) + call LIS_verify(status) ! Input is actually convective precip fraction; Calc actual CPCP below - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if (nldas20_struc(n)%metdata2(kk,9,index1).ne.LIS_rc%udef) then - cpcp(t) = nldas20_struc(n)%metdata2(kk,9,index1) - if (nldas20_struc(n)%model_pcp_data.gt.0) then - cpcp(t) = cpcp(t) / (60.0*60.0) - else - cpcp(t) = cpcp(t) * pcp(t) - endif - endif - enddo - enddo + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if (nldas20_struc(n)%metdata2(kk,9,index1).ne.LIS_rc%udef) then + cpcp(t) = nldas20_struc(n)%metdata2(kk,9,index1) + if (nldas20_struc(n)%model_pcp_data.gt.0) then + cpcp(t) = cpcp(t) / (60.0*60.0) + else + cpcp(t) = cpcp(t) * pcp(t) + endif + endif + enddo + enddo ! Linearly interpolate everything else - call ESMF_FieldGet(tmpField,localDE=0,farrayPtr=tmp,rc=status) - call LIS_verify(status) - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,1,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,1,index1).ne.LIS_rc%udef)) then - tmp(t) = (nldas20_struc(n)%metdata1(kk,1,index1)*wt1) + & - (nldas20_struc(n)%metdata2(kk,1,index1)*wt2) - endif - enddo - enddo - - call ESMF_FieldGet(q2Field,localDE=0,farrayPtr=q2,rc=status) - call LIS_verify(status) - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,2,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,2,index1).ne.LIS_rc%udef)) then - q2(t) = (nldas20_struc(n)%metdata1(kk,2,index1)*wt1) + & - (nldas20_struc(n)%metdata2(kk,2,index1)*wt2) - endif - enddo - enddo - - call ESMF_FieldGet(lwdField,localDE=0,farrayPtr=lwd,rc=status) - call LIS_verify(status) - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,4,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,4,index1).ne.LIS_rc%udef)) then - lwd(t) = (nldas20_struc(n)%metdata1(kk,4,index1)*wt1) + & - (nldas20_struc(n)%metdata2(kk,4,index1)*wt2) - endif - enddo - enddo - - call ESMF_FieldGet(uField,localDE=0,farrayPtr=uwind,rc=status) - call LIS_verify(status) - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,5,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,5,index1).ne.LIS_rc%udef)) then - uwind(t) = (nldas20_struc(n)%metdata1(kk,5,index1)*wt1)+& - (nldas20_struc(n)%metdata2(kk,5,index1)*wt2) - endif - enddo - enddo - - call ESMF_FieldGet(vField,localDE=0,farrayPtr=vwind,rc=status) - call LIS_verify(status) - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,6,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,6,index1).ne.LIS_rc%udef)) then - vwind(t) = (nldas20_struc(n)%metdata1(kk,6,index1)*wt1)+& - (nldas20_struc(n)%metdata2(kk,6,index1)*wt2) - endif - enddo - enddo - - call ESMF_FieldGet(psurfField,localDE=0,farrayPtr=psurf,rc=status) - call LIS_verify(status) - - do k = 1,(LIS_rc%ntiles(n)/mfactor) - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,7,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,7,index1).ne.LIS_rc%udef)) then - psurf(t) = (nldas20_struc(n)%metdata1(kk,7,index1)*wt1)+& - (nldas20_struc(n)%metdata2(kk,7,index1)*wt2) - endif - enddo - enddo - - if (forcing_PET) then - call ESMF_FieldGet(PETField,localDE=0,farrayPtr=pet,rc=status) - call LIS_verify(status) - - do k = 1,LIS_rc%ntiles(n)/mfactor - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,10,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,10,index1).ne.LIS_rc%udef)) then - pet(t) = (nldas20_struc(n)%metdata1(kk,10,index1)*wt1)+& - (nldas20_struc(n)%metdata2(kk,10,index1)*wt2) -! Convert NLDAS-2 PET from kg/m^2 to kg/m^2/sec - dmm - pet(t) = pet(t)/(60.0*60.0) - endif - enddo - enddo - endif - - if (forcing_CAPE) then - call ESMF_FieldGet(CAPEField,localDE=0,farrayPtr=cape,rc=status) - call LIS_verify(status) - - do k = 1,LIS_rc%ntiles(n)/mfactor - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,11,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,11,index1).ne.LIS_rc%udef)) then - cape(t) = (nldas20_struc(n)%metdata1(kk,11,index1)*wt1)+& - (nldas20_struc(n)%metdata2(kk,11,index1)*wt2) - endif - enddo - enddo - endif - - if (forcing_z) then - call ESMF_FieldGet(fhgtField,localDE=0,farrayPtr=fheight,rc=status) - call LIS_verify(status) - - do k = 1,LIS_rc%ntiles(n)/mfactor - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,12,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,12,index1).ne.LIS_rc%udef)) then - fheight(t) = (nldas20_struc(n)%metdata1(kk,12,index1)*wt1)+& - (nldas20_struc(n)%metdata2(kk,12,index1)*wt2) - endif - enddo - enddo - endif - - if (forcing_ch) then - call ESMF_FieldGet(acondField,localDE=0,farrayPtr=acond,rc=status) - call LIS_verify(status) - - do k = 1,LIS_rc%ntiles(n)/mfactor - do m = 1,mfactor - t = m + (k-1)*mfactor - index1 = LIS_domain(n)%tile(t)%index - kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,13,index1).ne.LIS_rc%udef).and.& - (nldas20_struc(n)%metdata2(kk,13,index1).ne.LIS_rc%udef)) then - acond(t) = (nldas20_struc(n)%metdata1(kk,13,index1)*wt1)+& - (nldas20_struc(n)%metdata2(kk,13,index1)*wt2) - endif - enddo - enddo - endif - - end subroutine timeinterp_nldas20 + call ESMF_FieldGet(tmpField,localDE=0,farrayPtr=tmp,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,1,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,1,index1).ne.LIS_rc%udef)) then + tmp(t) = (nldas20_struc(n)%metdata1(kk,1,index1)*wt1) + & + (nldas20_struc(n)%metdata2(kk,1,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(q2Field,localDE=0,farrayPtr=q2,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,2,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,2,index1).ne.LIS_rc%udef)) then + q2(t) = (nldas20_struc(n)%metdata1(kk,2,index1)*wt1) + & + (nldas20_struc(n)%metdata2(kk,2,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(lwdField,localDE=0,farrayPtr=lwd,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,4,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,4,index1).ne.LIS_rc%udef)) then + lwd(t) = (nldas20_struc(n)%metdata1(kk,4,index1)*wt1) + & + (nldas20_struc(n)%metdata2(kk,4,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(uField,localDE=0,farrayPtr=uwind,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,5,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,5,index1).ne.LIS_rc%udef)) then + uwind(t) = (nldas20_struc(n)%metdata1(kk,5,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,5,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(vField,localDE=0,farrayPtr=vwind,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,6,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,6,index1).ne.LIS_rc%udef)) then + vwind(t) = (nldas20_struc(n)%metdata1(kk,6,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,6,index1)*wt2) + endif + enddo + enddo + + call ESMF_FieldGet(psurfField,localDE=0,farrayPtr=psurf,rc=status) + call LIS_verify(status) + + do k = 1,(LIS_rc%ntiles(n)/mfactor) + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,7,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,7,index1).ne.LIS_rc%udef)) then + psurf(t) = (nldas20_struc(n)%metdata1(kk,7,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,7,index1)*wt2) + endif + enddo + enddo + + if (forcing_PET) then + call ESMF_FieldGet(PETField,localDE=0,farrayPtr=pet,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,10,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,10,index1).ne.LIS_rc%udef)) then + pet(t) = (nldas20_struc(n)%metdata1(kk,10,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,10,index1)*wt2) + ! Convert NLDAS-2 PET from kg/m^2 to kg/m^2/sec - dmm + pet(t) = pet(t)/(60.0*60.0) + endif + enddo + enddo + endif + + if (forcing_CAPE) then + call ESMF_FieldGet(CAPEField,localDE=0,farrayPtr=cape,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,11,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,11,index1).ne.LIS_rc%udef)) then + cape(t) = (nldas20_struc(n)%metdata1(kk,11,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,11,index1)*wt2) + endif + enddo + enddo + endif + + if (forcing_z) then + call ESMF_FieldGet(fhgtField,localDE=0,farrayPtr=fheight,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,12,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,12,index1).ne.LIS_rc%udef)) then + fheight(t) = (nldas20_struc(n)%metdata1(kk,12,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,12,index1)*wt2) + endif + enddo + enddo + endif + + if (forcing_ch) then + call ESMF_FieldGet(acondField,localDE=0,farrayPtr=acond,rc=status) + call LIS_verify(status) + + do k = 1,LIS_rc%ntiles(n)/mfactor + do m = 1,mfactor + t = m + (k-1)*mfactor + index1 = LIS_domain(n)%tile(t)%index + kk = LIS_get_iteration_index(n,k,index1,mfactor) + if ((nldas20_struc(n)%metdata1(kk,13,index1).ne.LIS_rc%udef).and.& + (nldas20_struc(n)%metdata2(kk,13,index1).ne.LIS_rc%udef)) then + acond(t) = (nldas20_struc(n)%metdata1(kk,13,index1)*wt1)+& + (nldas20_struc(n)%metdata2(kk,13,index1)*wt2) + endif + enddo + enddo + endif + +end subroutine timeinterp_nldas20 From 303dfe12979dbfe9237e2fc2b70c63ded2bcacc6 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 23 Jul 2024 08:52:03 -0400 Subject: [PATCH 11/12] Tweaks to continuation markers. No changes in results. --- .../nldas-2.0/get_netcdf4_filenames.F90 | 8 +-- lis/metforcing/nldas-2.0/get_nldas20.F90 | 2 +- .../nldas-2.0/nldas20_forcingMod.F90 | 34 ++++++------- .../nldas-2.0/read_nldas20_elev.F90 | 6 +-- lis/metforcing/nldas-2.0/read_nldas20a.F90 | 16 +++--- lis/metforcing/nldas-2.0/read_nldas20b.F90 | 4 +- .../nldas-2.0/read_orig_nldas20_elevdiff.F90 | 2 +- lis/metforcing/nldas-2.0/readcrd_nldas20.F90 | 8 +-- .../nldas-2.0/timeinterp_nldas20.F90 | 50 +++++++++---------- 9 files changed, 65 insertions(+), 65 deletions(-) diff --git a/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 index 9558ed31b..eb3b590aa 100644 --- a/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 +++ b/lis/metforcing/nldas-2.0/get_netcdf4_filenames.F90 @@ -71,7 +71,7 @@ subroutine netcdf4_nldas20filea(n,kk,findex,filename, & !=== Assemble GES DISC NLDAS-2 netCDF-4 FORA filename: filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & + "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & "00.020.nc" else ! forecast mode @@ -103,7 +103,7 @@ subroutine netcdf4_nldas20filea(n,kk,findex,filename, & !=== Assemble GES DISC NLDAS-2 netCDF-4 FORA filename: filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & + "/NLDAS_FORA0125_H.A"//fyr//fmo//fda//"."//fhr// & "00.020.nc" endif @@ -173,7 +173,7 @@ subroutine netcdf4_nldas20fileb(n,kk,findex,filename, & !=== Assemble GES DISC NLDAS-2 netCDF-4 FORB filename: filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & + "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & "00.020.nc" else !forecast mode @@ -205,7 +205,7 @@ subroutine netcdf4_nldas20fileb(n,kk,findex,filename, & !=== Assemble GES DISC NLDAS-2 netCDF-4 FORB filename: filename = trim(nldas20dir)//"/"//fyr//"/"//fdoy// & - "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & + "/NLDAS_FORB0125_H.A"//fyr//fmo//fda//"."//fhr// & "00.020.nc" endif diff --git a/lis/metforcing/nldas-2.0/get_nldas20.F90 b/lis/metforcing/nldas-2.0/get_nldas20.F90 index cc43a5ecb..8d4a41c10 100644 --- a/lis/metforcing/nldas-2.0/get_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/get_nldas20.F90 @@ -81,7 +81,7 @@ subroutine get_nldas20(n,findex) !=== Check to see if b-file needs to be opened readbfile = 0 - if ((nldas20_struc(n)%model_level_data.gt.0).or. & + if ((nldas20_struc(n)%model_level_data.gt.0).or. & (nldas20_struc(n)%model_dswrf_data.gt.0).or. & (nldas20_struc(n)%model_level_press.gt.0).or. & (nldas20_struc(n)%model_pcp_data.gt.0)) then diff --git a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 index 60e5cbd58..7dfd35f4a 100644 --- a/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 +++ b/lis/metforcing/nldas-2.0/nldas20_forcingMod.F90 @@ -200,10 +200,10 @@ subroutine init_NLDAS20(findex) endif allocate(nldas20_struc(n)%metdata1( & - LIS_forecast_struc(1)%niterations, & + LIS_forecast_struc(1)%niterations, & LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) allocate(nldas20_struc(n)%metdata2( & - LIS_forecast_struc(1)%niterations,& + LIS_forecast_struc(1)%niterations, & LIS_rc%met_nf(findex),LIS_rc%ngrid(n))) nldas20_struc(n)%st_iterid = LIS_forecast_struc(1)%st_iterId @@ -212,9 +212,9 @@ subroutine init_NLDAS20(findex) ! Regular retrospective or non-forecast mode: else - allocate(nldas20_struc(n)%metdata1(1,LIS_rc%met_nf(findex),& + allocate(nldas20_struc(n)%metdata1(1,LIS_rc%met_nf(findex), & LIS_rc%ngrid(n))) - allocate(nldas20_struc(n)%metdata2(1,LIS_rc%met_nf(findex),& + allocate(nldas20_struc(n)%metdata2(1,LIS_rc%met_nf(findex), & LIS_rc%ngrid(n))) nldas20_struc(n)%st_iterid = 1 @@ -240,9 +240,9 @@ subroutine init_NLDAS20(findex) nldas20_struc(n)%gridDesc(20) = 64 ! Check for grid and interp option selected: - if ((nldas20_struc(n)%gridDesc(9).eq.LIS_rc%gridDesc(n,9)).and.& - (nldas20_struc(n)%gridDesc(10).eq.LIS_rc%gridDesc(n,10)).and.& - (LIS_rc%gridDesc(n,1).eq.proj_latlon).and. & + if ((nldas20_struc(n)%gridDesc(9).eq.LIS_rc%gridDesc(n,9)).and. & + (nldas20_struc(n)%gridDesc(10).eq.LIS_rc%gridDesc(n,10)).and. & + (LIS_rc%gridDesc(n,1).eq.proj_latlon).and. & (LIS_rc%met_interp(findex).ne."neighbor")) then write(LIS_logunit,*) & "[ERR] The NLDAS grid was selected for the LIS run domain;" @@ -274,9 +274,9 @@ subroutine init_NLDAS20(findex) allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & - nldas20_struc(n)%n111,nldas20_struc(n)%n121, & - nldas20_struc(n)%n211,nldas20_struc(n)%n221, & - nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & nldas20_struc(n)%w211,nldas20_struc(n)%w221) case ("budget-bilinear") @@ -290,9 +290,9 @@ subroutine init_NLDAS20(findex) allocate(nldas20_struc(n)%w221(LIS_rc%lnc(n)*LIS_rc%lnr(n))) call bilinear_interp_input(n,nldas20_struc(n)%gridDesc(:), & - nldas20_struc(n)%n111,nldas20_struc(n)%n121, & - nldas20_struc(n)%n211,nldas20_struc(n)%n221, & - nldas20_struc(n)%w111,nldas20_struc(n)%w121, & + nldas20_struc(n)%n111,nldas20_struc(n)%n121, & + nldas20_struc(n)%n211,nldas20_struc(n)%n221, & + nldas20_struc(n)%w111,nldas20_struc(n)%w121, & nldas20_struc(n)%w211,nldas20_struc(n)%w221) allocate(nldas20_struc(n)%n112(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) @@ -305,9 +305,9 @@ subroutine init_NLDAS20(findex) allocate(nldas20_struc(n)%w222(LIS_rc%lnc(n)*LIS_rc%lnr(n),25)) call conserv_interp_input(n,nldas20_struc(n)%gridDesc(:), & - nldas20_struc(n)%n112,nldas20_struc(n)%n122, & - nldas20_struc(n)%n212,nldas20_struc(n)%n222, & - nldas20_struc(n)%w112,nldas20_struc(n)%w122, & + nldas20_struc(n)%n112,nldas20_struc(n)%n122, & + nldas20_struc(n)%n212,nldas20_struc(n)%n222, & + nldas20_struc(n)%w112,nldas20_struc(n)%w122, & nldas20_struc(n)%w212,nldas20_struc(n)%w222) case ("neighbor") @@ -333,7 +333,7 @@ subroutine init_NLDAS20(findex) ! Set up precipitation climate downscaling: if (LIS_rc%pcp_downscale(findex).ne.0) then call LIS_init_pcpclimo_native(n,findex, & - nint(nldas20_struc(n)%gridDesc(2)), & + nint(nldas20_struc(n)%gridDesc(2)), & nint(nldas20_struc(n)%gridDesc(3))) endif enddo diff --git a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 index 25fc7b1cc..1e614c64e 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20_elev.F90 @@ -65,7 +65,7 @@ subroutine read_nldas20_elev(n,findex) "[INFO] Reading NLDAS-2 elevation data ... " call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & - mode=NF90_NOWRITE,ncid=nid), & + mode=NF90_NOWRITE,ncid=nid), & "nf90_open failed in read_nldas20_elev") call LIS_verify(nf90_inq_varid(nid,"ELEV_NLDAS2",elevId), & "nf90_inq_varid failed in read_nldas20_elev") @@ -74,8 +74,8 @@ subroutine read_nldas20_elev(n,findex) call LIS_verify(nf90_close(nid)) elev_subset(:,:) = elev(LIS_ews_halo_ind(n,LIS_localPet+1): & - LIS_ewe_halo_ind(n,LIS_localPet+1), & - LIS_nss_halo_ind(n,LIS_localPet+1): & + LIS_ewe_halo_ind(n,LIS_localPet+1), & + LIS_nss_halo_ind(n,LIS_localPet+1): & LIS_nse_halo_ind(n,LIS_localPet+1)) do r = 1,LIS_rc%lnr(n) diff --git a/lis/metforcing/nldas-2.0/read_nldas20a.F90 b/lis/metforcing/nldas-2.0/read_nldas20a.F90 index 159edf858..f1dd216f5 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20a.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20a.F90 @@ -152,7 +152,7 @@ subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) do t = 1,nldas20 if (lb(t)) then call nldas20_ec_removal(n,t,nldas20_forcing(t,1), & - nldas20_forcing(t,2),nldas20_forcing(t,4), & + nldas20_forcing(t,2),nldas20_forcing(t,4), & nldas20_forcing(t,7)) endif enddo @@ -163,8 +163,8 @@ subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) if ((iv.eq.8).or.(iv.eq.9)) pcp_flag = .true. call interp_nldas20(n,findex,month,pcp_flag,nldas20, & - nldas20_forcing(:,iv), & - lb,LIS_rc%gridDesc(n,:), & + nldas20_forcing(:,iv), & + lb,LIS_rc%gridDesc(n,:), & LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) do r = 1,LIS_rc%lnr(n) @@ -298,7 +298,7 @@ subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & select case(LIS_rc%met_interp(findex)) case("bilinear") - call bilinear_interp(lis_gds,input_bitmap,input_data, & + call bilinear_interp(lis_gds,input_bitmap,input_data, & output_bitmap,output_data,nldas20_struc(n)%mi,mo, & LIS_domain(n)%lat,LIS_domain(n)%lon, & nldas20_struc(n)%w111,nldas20_struc(n)%w121, & @@ -309,7 +309,7 @@ subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & case("budget-bilinear") if (pcp_flag) then - call conserv_interp(lis_gds,input_bitmap,input_data, & + call conserv_interp(lis_gds,input_bitmap,input_data, & output_bitmap,output_data,nldas20_struc(n)%mi,mo, & LIS_domain(n)%lat,LIS_domain(n)%lon, & nldas20_struc(n)%w112,nldas20_struc(n)%w122, & @@ -319,7 +319,7 @@ subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & LIS_rc%udef,iret) else - call bilinear_interp(lis_gds,input_bitmap,input_data, & + call bilinear_interp(lis_gds,input_bitmap,input_data, & output_bitmap,output_data,nldas20_struc(n)%mi,mo, & LIS_domain(n)%lat,LIS_domain(n)%lon, & nldas20_struc(n)%w111,nldas20_struc(n)%w121, & @@ -330,7 +330,7 @@ subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & endif case("neighbor") - call neighbor_interp(lis_gds,input_bitmap,input_data, & + call neighbor_interp(lis_gds,input_bitmap,input_data, & output_bitmap,output_data,nldas20_struc(n)%mi,mo, & LIS_domain(n)%lat,LIS_domain(n)%lon, & nldas20_struc(n)%n113,LIS_rc%udef,iret) @@ -338,7 +338,7 @@ subroutine interp_nldas20(n,findex,month,pcp_flag,input_size, & end select if (pcp_flag.and.(LIS_rc%pcp_downscale(findex).ne.0)) then - call LIS_pcpClimoDownscaling(n,findex,month,nc*nr, & + call LIS_pcpClimoDownscaling(n,findex,month,nc*nr, & output_data,output_bitmap) endif diff --git a/lis/metforcing/nldas-2.0/read_nldas20b.F90 b/lis/metforcing/nldas-2.0/read_nldas20b.F90 index a1cc53eb8..dbcc5357d 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20b.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20b.F90 @@ -148,8 +148,8 @@ subroutine read_nldas20b(n,kk,findex,order,name,ferror) if ((iv.eq.2).or.(iv.eq.3)) pcp_flag = .true. call interp_nldas20(n,findex,LIS_rc%mo,pcp_flag,nldas20, & - nldas20_forcing(:,iv), & - lb,LIS_rc%gridDesc(n,:), & + nldas20_forcing(:,iv), & + lb,LIS_rc%gridDesc(n,:), & LIS_rc%lnc(n),LIS_rc%lnr(n),varfield) do r = 1,LIS_rc%lnr(n) diff --git a/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 index 44b99987d..394cc39a0 100644 --- a/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 +++ b/lis/metforcing/nldas-2.0/read_orig_nldas20_elevdiff.F90 @@ -55,7 +55,7 @@ subroutine read_orig_nldas20_elevdiff(n) "[INFO] Reading NLDAS-2 original elevation difference file ..." call LIS_verify(nf90_open(path=LIS_rc%paramfile(n), & - mode=NF90_NOWRITE,ncid=nid), & + mode=NF90_NOWRITE,ncid=nid), & "nf90_open failed in read_orig_nldas20_elevdiff") call LIS_verify(nf90_inq_varid(nid,"ELEVDIFF_NLDAS2",elevId), & "nf90_inq_varid failed in read_orig_nldas20_elevdiff") diff --git a/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 index 46fb5e33b..2f599f52e 100644 --- a/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/readcrd_nldas20.F90 @@ -90,7 +90,7 @@ subroutine readcrd_nldas20() do n = 1,LIS_rc%nnest write(unit=LIS_logunit,fmt=*) & - "[INFO] NLDAS-2.0 FORA forcing directory: ", & + "[INFO] NLDAS-2.0 FORA forcing directory: ", & trim(nldas20_struc(n)%nldas20foradir) nldas20_struc(n)%ncold = 464 nldas20_struc(n)%nrold = 224 @@ -98,8 +98,8 @@ subroutine readcrd_nldas20() nldas20_struc(n)%nldas20time2 = 0.0 if ((nldas20_struc(n)%model_level_data.eq.1).or. & - (nldas20_struc(n)%model_dswrf_data.eq.1).or. & - (nldas20_struc(n)%model_pcp_data.eq.1).or. & + (nldas20_struc(n)%model_dswrf_data.eq.1).or. & + (nldas20_struc(n)%model_pcp_data.eq.1).or. & (nldas20_struc(n)%model_level_press.eq.1)) then call ESMF_ConfigFindLabel(LIS_config, & "NLDAS-2.0 FORB forcing directory:",rc=rc) @@ -108,7 +108,7 @@ subroutine readcrd_nldas20() call ESMF_ConfigGetAttribute(LIS_config, & nldas20_struc(n)%nldas20forbdir,rc=rc) write(unit=LIS_logunit,fmt=*) & - "[INFO] NLDAS-2.0 FORB forcing directory: ", & + "[INFO] NLDAS-2.0 FORB forcing directory: ", & trim(nldas20_struc(n)%nldas20forbdir) endif enddo diff --git a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 index e1be31d31..6d39a0cd9 100644 --- a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 @@ -89,7 +89,7 @@ subroutine timeinterp_nldas20(n,findex) tempbmn = bmn tempbss = 0 tempbts = 0 - call LIS_tick(newtime1,tempbdoy,tempgmt1,tempbyr,tempbmo,tempbda,& + call LIS_tick(newtime1,tempbdoy,tempgmt1,tempbyr,tempbmo,tempbda, & tempbhr,tempbmn,tempbss,tempbts) btime = nldas20_struc(n)%nldas20time2 @@ -104,7 +104,7 @@ subroutine timeinterp_nldas20(n,findex) tempbmn = bmn tempbss = 0 tempbts = 0 - call LIS_tick(newtime2,tempbdoy,tempgmt2,tempbyr,tempbmo,tempbda,& + call LIS_tick(newtime2,tempbdoy,tempgmt2,tempbyr,tempbmo,tempbda, & tempbhr,tempbmn,tempbss,tempbts) !=== Interpolate Data in time @@ -234,8 +234,8 @@ subroutine timeinterp_nldas20(n,findex) zdoy = LIS_rc%doy ! Compute and apply zenith angle weights call zterp(1,LIS_domain(n)%grid(index1)%lat, & - LIS_domain(n)%grid(index1)%lon, & - gmt1,gmt2,LIS_rc%gmt,zdoy,zw1,zw2, & + LIS_domain(n)%grid(index1)%lon, & + gmt1,gmt2,LIS_rc%gmt,zdoy,zw1,zw2, & czb,cze,czm,LIS_rc) kk = LIS_get_iteration_index(n,k,index1,mfactor) @@ -246,10 +246,10 @@ subroutine timeinterp_nldas20(n,findex) (nldas20_struc(n)%metdata2(kk,3,index1)*zw2) ! In cases of small cos(zenith) angles, use linear weighting ! to avoid overly large weights. - if ((swd(t).gt.nldas20_struc(n)%metdata1(kk,3,index1)).and.& - (swd(t).gt.nldas20_struc(n)%metdata2(kk,3,index1)).and.& + if ((swd(t).gt.nldas20_struc(n)%metdata1(kk,3,index1)).and. & + (swd(t).gt.nldas20_struc(n)%metdata2(kk,3,index1)).and. & ((czb.lt.0.1).or.(cze.lt.0.1))) then - swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*swt1)+ & + swd(t) = (nldas20_struc(n)%metdata1(kk,3,index1)*swt1) + & (nldas20_struc(n)%metdata2(kk,3,index1)*swt2) endif endif @@ -316,7 +316,7 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,1,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,1,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,1,index1).ne.LIS_rc%udef)) then tmp(t) = (nldas20_struc(n)%metdata1(kk,1,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,1,index1)*wt2) @@ -332,9 +332,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,2,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,2,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,2,index1).ne.LIS_rc%udef)) then - q2(t) = (nldas20_struc(n)%metdata1(kk,2,index1)*wt1) + & + q2(t) = (nldas20_struc(n)%metdata1(kk,2,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,2,index1)*wt2) endif enddo @@ -348,7 +348,7 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,4,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,4,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,4,index1).ne.LIS_rc%udef)) then lwd(t) = (nldas20_struc(n)%metdata1(kk,4,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,4,index1)*wt2) @@ -364,9 +364,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,5,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,5,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,5,index1).ne.LIS_rc%udef)) then - uwind(t) = (nldas20_struc(n)%metdata1(kk,5,index1)*wt1)+& + uwind(t) = (nldas20_struc(n)%metdata1(kk,5,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,5,index1)*wt2) endif enddo @@ -380,9 +380,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,6,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,6,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,6,index1).ne.LIS_rc%udef)) then - vwind(t) = (nldas20_struc(n)%metdata1(kk,6,index1)*wt1)+& + vwind(t) = (nldas20_struc(n)%metdata1(kk,6,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,6,index1)*wt2) endif enddo @@ -396,9 +396,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,7,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,7,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,7,index1).ne.LIS_rc%udef)) then - psurf(t) = (nldas20_struc(n)%metdata1(kk,7,index1)*wt1)+& + psurf(t) = (nldas20_struc(n)%metdata1(kk,7,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,7,index1)*wt2) endif enddo @@ -413,9 +413,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,10,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,10,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,10,index1).ne.LIS_rc%udef)) then - pet(t) = (nldas20_struc(n)%metdata1(kk,10,index1)*wt1)+& + pet(t) = (nldas20_struc(n)%metdata1(kk,10,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,10,index1)*wt2) ! Convert NLDAS-2 PET from kg/m^2 to kg/m^2/sec - dmm pet(t) = pet(t)/(60.0*60.0) @@ -433,9 +433,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,11,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,11,index1).ne.LIS_rc%udef) .and. & (nldas20_struc(n)%metdata2(kk,11,index1).ne.LIS_rc%udef)) then - cape(t) = (nldas20_struc(n)%metdata1(kk,11,index1)*wt1)+& + cape(t) = (nldas20_struc(n)%metdata1(kk,11,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,11,index1)*wt2) endif enddo @@ -451,9 +451,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,12,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,12,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,12,index1).ne.LIS_rc%udef)) then - fheight(t) = (nldas20_struc(n)%metdata1(kk,12,index1)*wt1)+& + fheight(t) = (nldas20_struc(n)%metdata1(kk,12,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,12,index1)*wt2) endif enddo @@ -469,9 +469,9 @@ subroutine timeinterp_nldas20(n,findex) t = m + (k-1)*mfactor index1 = LIS_domain(n)%tile(t)%index kk = LIS_get_iteration_index(n,k,index1,mfactor) - if ((nldas20_struc(n)%metdata1(kk,13,index1).ne.LIS_rc%udef).and.& + if ((nldas20_struc(n)%metdata1(kk,13,index1).ne.LIS_rc%udef).and. & (nldas20_struc(n)%metdata2(kk,13,index1).ne.LIS_rc%udef)) then - acond(t) = (nldas20_struc(n)%metdata1(kk,13,index1)*wt1)+& + acond(t) = (nldas20_struc(n)%metdata1(kk,13,index1)*wt1) + & (nldas20_struc(n)%metdata2(kk,13,index1)*wt2) endif enddo From 0c8cac08b47ba1d3f29904d0c0d90bc89e2f4df4 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 23 Jul 2024 12:13:04 -0400 Subject: [PATCH 12/12] Revised warning and error message tags for consistency. [ERR] usually means LIS cannot continue, so messages for less serious events have been changed to [WARN]. Also changed "Error:" to "[ERR]" for consistency. --- lis/metforcing/nldas-2.0/read_nldas20a.F90 | 4 +-- lis/metforcing/nldas-2.0/read_nldas20b.F90 | 4 +-- .../nldas-2.0/timeinterp_nldas20.F90 | 26 +++++++++---------- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/lis/metforcing/nldas-2.0/read_nldas20a.F90 b/lis/metforcing/nldas-2.0/read_nldas20a.F90 index f1dd216f5..bd38878f1 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20a.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20a.F90 @@ -108,7 +108,7 @@ subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) if (file_exists) then iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) if (iret.ne.0) then - write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) + write(LIS_logunit,*) "[WARN] Could not open file: ",trim(name) ferror = 0 return endif @@ -183,7 +183,7 @@ subroutine read_nldas20a(n,kk,findex,order,month,name,ferror) enddo deallocate(lb) else - write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) + write(LIS_logunit,*) "[WARN] Could not find file: ",trim(name) ferror = 0 endif diff --git a/lis/metforcing/nldas-2.0/read_nldas20b.F90 b/lis/metforcing/nldas-2.0/read_nldas20b.F90 index dbcc5357d..b4de60393 100644 --- a/lis/metforcing/nldas-2.0/read_nldas20b.F90 +++ b/lis/metforcing/nldas-2.0/read_nldas20b.F90 @@ -104,7 +104,7 @@ subroutine read_nldas20b(n,kk,findex,order,name,ferror) if (file_exists) then iret = nf90_open(path=name,mode=NF90_NOWRITE,ncid=ftn) if (iret.ne.0) then - write(LIS_logunit,*) "[ERR] Could not open file: ",trim(name) + write(LIS_logunit,*) "[WARN] Could not open file: ",trim(name) ferror = 0 return endif @@ -292,7 +292,7 @@ subroutine read_nldas20b(n,kk,findex,order,name,ferror) enddo deallocate(lb) else - write(LIS_logunit,*) "[ERR] Could not find file: ",trim(name) + write(LIS_logunit,*) "[WARN] Could not find file: ",trim(name) ferror = 0 endif diff --git a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 index 6d39a0cd9..f0e04750d 100644 --- a/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 +++ b/lis/metforcing/nldas-2.0/timeinterp_nldas20.F90 @@ -117,47 +117,47 @@ subroutine timeinterp_nldas20(n,findex) call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Tair%varname(1),tmpField,rc=status) call LIS_verify(status, & - "Error: Enable Tair in the forcing variables list") + "[ERR] Enable Tair in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Qair%varname(1),q2Field,rc=status) call LIS_verify(status, & - "Error: Enable Qair in the forcing variables list") + "[ERR] Enable Qair in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_SWdown%varname(1),swdField,rc=status) call LIS_verify(status, & - "Error: Enable SWdown in the forcing variables list") + "[ERR] Enable SWdown in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_LWdown%varname(1),lwdField,rc=status) call LIS_verify(status, & - "Error: Enable LWdown in the forcing variables list") + "[ERR] Enable LWdown in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Wind_E%varname(1),uField,rc=status) call LIS_verify(status, & - "Error: Enable Wind_E in the forcing variables list") + "[ERR] Enable Wind_E in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Wind_N%varname(1),vField,rc=status) call LIS_verify(status, & - "Error: Enable Wind_N in the forcing variables list") + "[ERR] Enable Wind_N in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Psurf%varname(1),psurfField,rc=status) call LIS_verify(status, & - "Error: Enable Psurf in the forcing variables list") + "[ERR] Enable Psurf in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Rainf%varname(1),pcpField,rc=status) call LIS_verify(status, & - "Error: Enable Rainf in the forcing variables list") + "[ERR] Enable Rainf in the forcing variables list") call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_CRainf%varname(1),cpcpField,rc=status) call LIS_verify(status, & - "Error: Enable CRainf in the forcing variables list") + "[ERR] Enable CRainf in the forcing variables list") forcing_z = .false. forcing_ch = .false. @@ -166,7 +166,7 @@ subroutine timeinterp_nldas20(n,findex) call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Forc_Hgt%varname(1),fhgtField,rc=status) call LIS_verify(status, & - "Error: Enable Forc_Hgt in the forcing variables list") + "[ERR] Enable Forc_Hgt in the forcing variables list") forcing_z = .true. else write(LIS_logunit,*) & @@ -185,7 +185,7 @@ subroutine timeinterp_nldas20(n,findex) call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_Ch%varname(1),acondField,rc=status) call LIS_verify(status, & - "Error: Enable Ch in the forcing variables list") + "[ERR] Enable Ch in the forcing variables list") forcing_ch = .true. else write(LIS_logunit,*) & @@ -205,7 +205,7 @@ subroutine timeinterp_nldas20(n,findex) call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_PET%varname(1),PETField,rc=status) call LIS_verify(status, & - "Error: Enable PET in the forcing variables list") + "[ERR] Enable PET in the forcing variables list") forcing_pet = .true. else forcing_pet = .false. @@ -215,7 +215,7 @@ subroutine timeinterp_nldas20(n,findex) call ESMF_StateGet(LIS_FORC_Base_State(n,findex), & LIS_FORC_CAPE%varname(1),CAPEField,rc=status) call LIS_verify(status, & - "Error: Enable CAPE in the forcing variables list") + "[ERR] Enable CAPE in the forcing variables list") forcing_cape = .true. else forcing_cape = .false.