Merge branch 'support/lisf-557ww-7.6'

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
+::
 ....
 
 

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(:)

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)

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

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

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 ' // &

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

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)