diff --git a/lis/configs/lis.config.adoc b/lis/configs/lis.config.adoc index f446d2fea..4c239990a 100644 --- a/lis/configs/lis.config.adoc +++ b/lis/configs/lis.config.adoc @@ -5517,6 +5517,12 @@ Acceptable values are: `AGRMET GALWEM radiation data directory:` specifies the location of the GALWEM radiation data files. +`AGRMET number of gauge networks to use:` specifies nonnegative number +of gauge networks to use, to be identified in separate config entry. + +`AGRMET gauge networks to use::` specifies list of names of gauge +networks to be used. (One line of names per domain.) + .Example _lis.config_ entry .... AGRMET forcing directory: ./FORCING/ @@ -5590,6 +5596,10 @@ AGRMET use GFS precip: 1 AGRMET use GALWEM precip: 0 AGRMET radiation derived from: 'GALWEM_RAD' AGRMET GALWEM radiation data directory: GALWEM_Rad +AGRMET number of gauge networks to use: 7 +AGRMET gauge networks to use:: +AMIL CANA FAA ICAO WMO HADS NWSLI +:: .... diff --git a/lis/metforcing/usaf/AGRMET_forcingMod.F90 b/lis/metforcing/usaf/AGRMET_forcingMod.F90 index 32172d6f2..8b78b3d98 100644 --- a/lis/metforcing/usaf/AGRMET_forcingMod.F90 +++ b/lis/metforcing/usaf/AGRMET_forcingMod.F90 @@ -734,6 +734,10 @@ module AGRMET_forcingMod real, allocatable :: gfs_nrt_bias_ratio(:,:) real, allocatable :: galwem_nrt_bias_ratio(:,:) integer :: pcp_back_bias_ratio_month + + ! EMK Add list of gage networks to use + integer :: num_gage_networks + character(32), allocatable :: gage_networks(:) end type agrmet_type_dec type(agrmet_type_dec), allocatable :: agrmet_struc(:) diff --git a/lis/metforcing/usaf/AGRMET_getpcpobs.F90 b/lis/metforcing/usaf/AGRMET_getpcpobs.F90 index 80427b01d..7d93588a0 100644 --- a/lis/metforcing/usaf/AGRMET_getpcpobs.F90 +++ b/lis/metforcing/usaf/AGRMET_getpcpobs.F90 @@ -360,7 +360,7 @@ subroutine AGRMET_getpcpobs(n, j6hr, month, prcpwe, & write(LIS_logunit,*)'- CALLING STOREOBS TO PROCESS RAIN GAUGE DATA', j3hr write(LIS_logunit,*)' ' - call AGRMET_storeobs(nsize, nsize3, agrmet_struc(n)%max_pcpobs, & + call AGRMET_storeobs(n, nsize, nsize3, agrmet_struc(n)%max_pcpobs, & obs, obs3, ilat, ilon, & mscprc, sixprc, twfprc, network, plat_id, cdms_flag, bsn, & duration, j3hr, stncnt, alert_number, filename) @@ -370,7 +370,7 @@ subroutine AGRMET_getpcpobs(n, j6hr, month, prcpwe, & write(LIS_logunit,*)'- CALLING STOREOBS_OFFHOUR TO PROCESS 3HOUR RAIN GAUGE DATA', j3hr write(LIS_logunit,*)' ' - call AGRMET_storeobs_offhour(nsize, agrmet_struc(n)%max_pcpobs, & + call AGRMET_storeobs_offhour(n, nsize, agrmet_struc(n)%max_pcpobs, & obs3, ilat, ilon, & mscprc, sixprc, twfprc, network, plat_id, cdms_flag, bsn, & duration, nsize3, alert_number, filename) diff --git a/lis/metforcing/usaf/AGRMET_storeobs.F90 b/lis/metforcing/usaf/AGRMET_storeobs.F90 index 9eb050c7b..a05c3aa45 100644 --- a/lis/metforcing/usaf/AGRMET_storeobs.F90 +++ b/lis/metforcing/usaf/AGRMET_storeobs.F90 @@ -26,7 +26,7 @@ ! new unknown network is encountered..........Eric Kemp/NASA ! ! !INTERFACE: -subroutine AGRMET_storeobs(nsize, nsize3, isize, obs, obs3, ilat, ilon, & +subroutine AGRMET_storeobs(n, nsize, nsize3, isize, obs, obs3, ilat, ilon, & mscprc, sixprc, twfprc, network, plat_id, cdms_flag, bsn, & duration, julhr, stncnt, alert_number, filename) @@ -37,6 +37,7 @@ subroutine AGRMET_storeobs(nsize, nsize3, isize, obs, obs3, ilat, ilon, & implicit none + integer, intent(in) :: n integer, intent(in) :: isize character*10, intent(in) :: network(isize) character*10, intent(in) :: plat_id(isize) @@ -253,7 +254,7 @@ subroutine AGRMET_storeobs(nsize, nsize3, isize, obs, obs3, ilat, ilon, & ! EMK 20240523...Skip report if network is not recognized. Issue an ! alert. Keep track of unknown networks to avoid redundant alerts. - if (.not. USAF_is_gauge(network(irecord))) then + if (.not. USAF_is_gauge(network(irecord),n)) then do i = 1, MAX_NEW_NETWORKS if (new_networks(i) == network(irecord)) then cycle RECORD diff --git a/lis/metforcing/usaf/AGRMET_storeobs_offhour.F90 b/lis/metforcing/usaf/AGRMET_storeobs_offhour.F90 index 13e7047c4..9851a4d82 100644 --- a/lis/metforcing/usaf/AGRMET_storeobs_offhour.F90 +++ b/lis/metforcing/usaf/AGRMET_storeobs_offhour.F90 @@ -20,7 +20,7 @@ ! new unknown network is encountered..........Eric Kemp/NASA ! ! !INTERFACE: -subroutine AGRMET_storeobs_offhour(nsize, isize, obs, ilat, ilon, & +subroutine AGRMET_storeobs_offhour(n, nsize, isize, obs, ilat, ilon, & mscprc, sixprc, twfprc, network, plat_id, cdms_flag, bsn, & duration, stncnt, alert_number, filename) @@ -31,6 +31,7 @@ subroutine AGRMET_storeobs_offhour(nsize, isize, obs, ilat, ilon, & implicit none + integer, intent(in) :: n integer, intent(in) :: isize character*10, intent(in) :: network(isize) character*10, intent(in) :: plat_id(isize) @@ -215,7 +216,7 @@ subroutine AGRMET_storeobs_offhour(nsize, isize, obs, ilat, ilon, & ! EMK 20240523...Skip report if network is not recognized. Issue an ! alert. Keep track of unknown networks to avoid redundant alerts. - if (.not. USAF_is_gauge(network(irecord))) then + if (.not. USAF_is_gauge(network(irecord),n)) then do i = 1, MAX_NEW_NETWORKS if (new_networks(i) == network(irecord)) then cycle RECORD diff --git a/lis/metforcing/usaf/USAF_PreobsReaderMod.F90 b/lis/metforcing/usaf/USAF_PreobsReaderMod.F90 index e92329c55..dbf390367 100644 --- a/lis/metforcing/usaf/USAF_PreobsReaderMod.F90 +++ b/lis/metforcing/usaf/USAF_PreobsReaderMod.F90 @@ -32,7 +32,7 @@ module USAF_PreobsReaderMod ! Read preobs files, perform simple preprocessing, and store ! in database. - subroutine USAF_read_preobs(preobsdir, presavdir, & + subroutine USAF_read_preobs(n, preobsdir, presavdir, & use_timestamp, & year, month, day, hour, use_expanded_station_ids, & alert_number) @@ -43,12 +43,14 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & use LIS_logMod, only: LIS_logunit, LIS_alert, LIS_getNextUnitNumber, & LIS_releaseUnitNumber use LIS_mpiMod, only: LIS_mpi_comm + use USAF_bratsethMod, only: USAF_is_gauge ! EMK 20240524 use USAF_GagesMod, only: USAF_Gages_t ! Defaults implicit none ! Arguments + integer, intent(in) :: n character(*), intent(in) :: preobsdir character(*), intent(in) :: presavdir integer, intent(in) :: use_timestamp @@ -124,6 +126,28 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & character(255) :: timestring integer :: iunit character(255) :: message(20) + integer, parameter :: MAX_NEW_NETWORKS = 20 + character(10), save :: new_networks(MAX_NEW_NETWORKS) = & + (/"NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL ", & + "NULL "/) message = '' @@ -147,6 +171,7 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & inquire(file=trim(filename), exist=found_file) if (.not. found_file) then write(LIS_logunit,*) '[WARN] Cannot find ', trim(filename) + message = '' message(1) = '[WARN] Program: LIS' message(2) = ' Routine: USAF_read_preobs' message(3) = ' Cannot find file ' // trim(filename) @@ -163,6 +188,7 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & open(iunit, file=trim(filename), status='old', iostat=ierr) if (ierr .ne. 0) then write(LIS_logunit,*) '[WARN] Problem opening ', trim(filename) + message = '' message(1) = '[WARN] Program: LIS' message(2) = ' Routine: USAF_read_preobs' message(3) = ' Cannot open file ' // trim(filename) @@ -180,6 +206,7 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & read(iunit, *, iostat=ierr) nsize if (ierr .ne. 0) then write(LIS_logunit,*) '[WARN] Problem reading ', trim(filename) + message = '' message(1) = '[WARN] Program: LIS' message(2) = ' Routine: USAF_read_preobs' message(3) = ' Problem reading file ' // trim(filename) @@ -196,6 +223,7 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & if (nsize == 0) then write(LIS_logunit,*)'[WARN] No precip obs found in ', & trim(filename) + message = '' message(1) = '[WARN] Program: LIS' message(2) = ' Routine: USAF_read_preobs' message(3) = ' No precip obs found in ' // trim(filename) @@ -319,6 +347,39 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & ! Skip if lat/lon is 0 (this is interpreted as missing). if (ilat_tmp == 0 .and. ilon_tmp == 0) cycle + ! EMK 20240524...Skip report if network is not recognized. + ! Issue an alert. Keep track of unknown networks to avoid + ! redundant alerts. + if (.not. USAF_is_gauge(network_tmp, n)) then + do j = 1, MAX_NEW_NETWORKS + if (new_networks(j) == network_tmp) then + exit ! Out of immediate do loop + else if (new_networks(j) == "NULL") then + new_networks(j) = network_tmp + write(LIS_logunit,*) & + '[WARN] Found unrecognized network ', & + trim(network_tmp) + write(LIS_logunit,*) & + '[WARN] Will skip report in preobs file' + message = '' + message(1) = '[WARN] Program: LIS' + message(2) = ' Routine: USAF_read_preobs' + message(3) = ' Found unrecognized network in '// & + trim(filename) + message(4) = ' Network '//trim(network_tmp) + message(5) = & + ' Modify lis.config to add this network' + if (LIS_masterproc) then + alert_number = alert_number + 1 + call LIS_alert('LIS.USAF_read_preobs', & + alert_number, message) + end if + exit ! Out of immediate do loop + end if + end do + cycle ! Read next report + end if + ! Skip reports that are too much after the analysis time ! (but allow earlier reports). This is a crude way of ! allowing for Australian reports that are sometimes one or @@ -736,6 +797,7 @@ subroutine USAF_read_preobs(preobsdir, presavdir, & write(LIS_logunit,*) & '[WARN] Will skip reconciling with obs from ', & abs(deltahr),' hours ago' + message = '' message(1) = '[WARN] Program: LIS' message(2) = ' Routine: USAF_read_preobs' message(3) = ' Cannot find earlier presav2 file ' // & diff --git a/lis/metforcing/usaf/USAF_bratsethMod.F90 b/lis/metforcing/usaf/USAF_bratsethMod.F90 index e0bff13a2..4370c0ec6 100644 --- a/lis/metforcing/usaf/USAF_bratsethMod.F90 +++ b/lis/metforcing/usaf/USAF_bratsethMod.F90 @@ -26,7 +26,7 @@ ! 21 Mar 2024 Changed internal BackQC and SuperstatQC logic to only ! skip for IMERG. This allows use with T, RH, and wind ! speed analyses..........................Eric Kemp/SSAI/NASA -! 23 May 2024 Export USAF_is_gauge function, and add HADS and +! 24 May 2024 Export USAF_is_gauge function, and add HADS and ! NWSLI gage networks.....................Eric Kemp/SSAI/NASA ! ! DESCRIPTION: @@ -141,7 +141,7 @@ module USAF_bratsethMod public :: USAF_snowDepthQC public :: USAF_backQC public :: USAF_superstatQC - ! EMK 20240523 + ! EMK 20240524 public :: USAF_is_gauge ! A simple linked list type that can be used in a hash table. Intended @@ -1987,7 +1987,7 @@ subroutine calc_invDataDensities(this,sigmaBSqr,nest,max_dist, & num = num + this%sigmaOSqr(job) else if (trim(this%net(iob)) .eq. trim(this%net(job))) then ! Satellite observations have correlated errors. - if (.not. isUncorrObType(this%net(job))) then + if (.not. isUncorrObType(this%net(job),nest)) then if (.not. this%oErrScaleLength(job) > 0 .and. & .not. this%oErrScaleLength(job) < 0) then write(LIS_logunit,*) & @@ -2302,7 +2302,7 @@ subroutine calc_obsAnalysis(this,sigmaBSqr,nobs,invDataDensities,nest,& else if (trim(this%net(iob)) .eq. & trim(this%net(job))) then ! Satellite data have horizontal error correlations - if (.not. isUncorrObType(this%net(job))) then + if (.not. isUncorrObType(this%net(job),nest)) then weight = weight + & obsErrCov(this%sigmaOSqr(job), & this%oErrScaleLength(job), & @@ -4285,23 +4285,37 @@ end subroutine USAF_backQC !--------------------------------------------------------------------------- ! Checks if observation network is recognized as a gauge. - logical function USAF_is_gauge(net) - implicit none - character(len=32), intent(in) :: net - logical :: answer - answer = .false. - if (net .eq. "AMIL") answer = .true. - if (net .eq. "CANA") answer = .true. - if (net .eq. "FAA") answer = .true. - if (net .eq. "HADS") answer = .true. ! EMK 20240523 - if (net .eq. "ICAO") answer = .true. - if (net .eq. "NWSLI") answer = .true. ! EMK 20240523 - if (net .eq. "WMO") answer = .true. - if (net .eq. "MOBL") answer = .true. - if (net .eq. "SUPERGAGE") answer = .true. - ! Handle reformatted CDMS data that are missing the network type. - if (net .eq. "CDMS") answer = .true. - USAF_is_gauge = answer + logical function USAF_is_gauge(net, n) result(answer) + + ! Imports + use AGRMET_forcingMod, only: agrmet_struc + + ! Defaults + implicit none + + ! Arguments + character(len=32), intent(in) :: net + integer, intent(in) :: n + + ! Locals + integer :: j + + answer = .false. ! First guess + + ! Two special cases + if (trim(net) .eq. "SUPERGAGE" .or. & + trim(net) .eq. "CDMS") then + answer = .true. + return + end if + + ! General case: Check list from LIS config file + do j = 1, agrmet_struc(n)%num_gage_networks + if (net == agrmet_struc(n)%gage_networks(j)) then + answer = .true. + exit + end if + end do end function USAF_is_gauge !--------------------------------------------------------------------------- @@ -4310,9 +4324,10 @@ end function USAF_is_gauge ! Bratseth routines that need to know which reports in a collection ! have correlated errors. When analyzing screen-level variables with ! surface stations, all observations should have uncorrelated errors. - logical function is_stn(net) + logical function is_stn(net, n) implicit none character(len=32), intent(in) :: net + integer, intent(in) :: n logical :: answer answer = .true. is_stn = answer diff --git a/lis/metforcing/usaf/USAF_getpcpobs.F90 b/lis/metforcing/usaf/USAF_getpcpobs.F90 index cf702b306..b62785950 100644 --- a/lis/metforcing/usaf/USAF_getpcpobs.F90 +++ b/lis/metforcing/usaf/USAF_getpcpobs.F90 @@ -82,7 +82,7 @@ subroutine USAF_getpcpobs(n, j6hr, month, use_twelve, pcp_src, & ! Read appropriate preobs file(s), intercompare with older presav2 ! files, and create new presav2 file for current date/time. - call USAF_read_preobs(preobsdir, & + call USAF_read_preobs(n, preobsdir, & trim(agrmet_struc(n)%analysisdir), & agrmet_struc(n)%use_timestamp, yr, mo, da, hr, & use_expanded_station_ids, alert_number) diff --git a/lis/metforcing/usaf/readcrd_agrmet.F90 b/lis/metforcing/usaf/readcrd_agrmet.F90 index debd77669..0d8c3b50f 100644 --- a/lis/metforcing/usaf/readcrd_agrmet.F90 +++ b/lis/metforcing/usaf/readcrd_agrmet.F90 @@ -31,6 +31,7 @@ ! 28 Aug 2018 Added IMERG...........................Eric Kemp/NASA/SSAI ! 21 Feb 2020 added support for 10-km GALWEM........Eric Kemp/NASA/SSAI ! 05 Mar 2020 added support for new GFS filename version...Eric Kemp/NASA/SSAI +! 28 May 2024 added list of gauge networks to use..........Eric Kemp/NASA/SSAI ! ! !INTERFACE: subroutine readcrd_agrmet() @@ -53,7 +54,7 @@ subroutine readcrd_agrmet() ! the LIS configuration file. ! !EOP - integer:: n,rc + integer:: n,rc,j character(len=10) :: cdate character(len=255) :: message(20) ! EMK real :: tmp_max_dist ! EMK @@ -1225,6 +1226,49 @@ subroutine readcrd_agrmet() end do end if + ! EMK Get list of gage networks to use + call ESMF_ConfigFindLabel(LIS_config, & + "AGRMET number of gauge networks to use:", rc=rc) + call LIS_verify(rc, & + "[ERR] AGRMET number of gauge networks to use: not specified in config file") + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, & + agrmet_struc(n)%num_gage_networks, rc=rc) + call LIS_verify(rc, & + "[ERR] AGRMET number of gauge networks to use: not specified in config file") + if (agrmet_struc(n)%num_gage_networks < 0) then + write(LIS_logunit,*) & + '[ERR] AGRMET number of gauge networks to use: must be nonnegative!' + write(LIS_logunit,*) & + '[ERR] Found ', agrmet_struc(n)%num_gage_networks + write(LIS_logunit, *) & + '[ERR] LIS will end!' + call LIS_verify(1, & + '[ERR] AGRMET number of gauge networks to use: must be nonnegative!') + end if + allocate(agrmet_struc(n)%gage_networks(agrmet_struc(n)%num_gage_networks)) + end do + call ESMF_ConfigFindLabel(LIS_config, & + 'AGRMET gauge networks to use::', rc=rc) + call LIS_verify(rc, & + "[ERR] AGRMET gauge networks to use:: not specified in config file") + do n=1, LIS_rc%nnest + call ESMF_ConfigNextLine(LIS_config, rc=rc) + call LIS_verify(rc, & + '[ERR] AGRMET gauge networks to use:: problem reading next line') + do j = 1, agrmet_struc(n)%num_gage_networks + call ESMF_ConfigGetAttribute(LIS_config, & + agrmet_struc(n)%gage_networks(j), rc=rc) + call LIS_verify(rc, & + '[ERR] AGRMET gauge networks to use:: problem reading entry') + end do + write(LIS_logunit,*) & + '[INFO] Will use following gauge networks for domain ', n + do j = 1, agrmet_struc(n)%num_gage_networks + write(LIS_logunit,*) trim(agrmet_struc(n)%gage_networks(j)) + end do + end do + do n=1,LIS_rc%nnest agrmet_struc(n)%radProcessInterval = 1 agrmet_struc(n)%radProcessAlarmTime = 0.0