Remove channels when writing to varobs (FCI setup)

src/opsinputs/opsinputs_varobswriter_mod.F90

@@ -718,6 +718,7 @@ subroutine opsinputs_varobswriter_populateobservations( &
 logical                                               :: FillChanNum = .false.
 logical                                               :: FillNumChans = .false.
 
+
 ! Body:
 
 ! Get the list of varfields to populate
@@ -1286,6 +1287,7 @@ subroutine opsinputs_varobswriter_fillchannumandnumchans( &
 integer(integer64)              :: ChannelIndices(Ob % Header % NumObsLocal, size(channels))
 integer(integer64)              :: ChannelCounts(Ob % Header % NumObsLocal)
 integer                         :: iChannel
+integer                         :: iVarChannel
 integer                         :: iObs
 real(kind=c_double)             :: MissingDouble
 integer(integer64)              :: array_loop
@@ -1329,9 +1331,19 @@ subroutine opsinputs_varobswriter_fillchannumandnumchans( &
 
 ChannelIndicesVar(:,:) = 0
 
-if (FillChanNum) then
-  call Ops_Alloc(Ob % Header % ChanNum, "ChanNum", Ob % Header % NumObsLocal, Ob % ChanNum, &
-                 num_levels = NumChannels)
+  if (FillChanNum) then
+    ! Allocate ChanNum. Use size(varChannels) as num_levels when varChannels is a strict
+    ! subset of channels and varObsSize_loc is non-zero (covers both size_of_varobs_array
+    ! equal to size(varChannels) and equal to size(channels)).
+    ! When varObsSize_loc == 0 we assign ChannelIndices directly, so allocate with NumChannels
+    ! = size(channels) so shapes always match.
+    if (size(varChannels) > 0 .and. size(varChannels) < size(channels) .and. varObsSize_loc /= 0) then
+      call Ops_Alloc(Ob % Header % ChanNum, "ChanNum", Ob % Header % NumObsLocal, Ob % ChanNum, &
+                     num_levels = int(size(varChannels), kind=integer64))
+    else
+      call Ops_Alloc(Ob % Header % ChanNum, "ChanNum", Ob % Header % NumObsLocal, Ob % ChanNum, &
+                     num_levels = NumChannels)
+    end if
   if ((varObsSize_loc /= 0)) then
     if (varObsSize_loc > size(channels)) then
       if (size(varChannels) > 0 .and. (size(channels) == size(varChannels))) then
@@ -1351,6 +1363,31 @@ subroutine opsinputs_varobswriter_fillchannumandnumchans( &
           end do
           Ob % ChanNum = ChannelIndicesVar
         end if
+      else if (size(varChannels) > 0 .and. (size(varChannels) < size(channels))) then
+          ! Only fill up to the number of varChannels, do not pad with IMDI
+          ChannelIndicesVar(:,:) = 0
+          do iObs = 1, Ob % Header % NumObsLocal
+            iVarChannel = 0
+            do iChannel = 1, ChannelCounts(iObs)
+              if (ChannelIndices(iObs, iChannel) > 0 .and. &
+                  ChannelIndices(iObs, iChannel) <= size(channels)) then
+                do array_loop = 1, size(varChannels)
+                  if (channels(ChannelIndices(iObs, iChannel)) == varChannels(array_loop)) then
+                    if (iVarChannel < size(varChannels)) then
+                      iVarChannel = iVarChannel + 1
+                      ChannelIndicesVar(iObs, iVarChannel) = varChannels(array_loop)
+                    end if
+                    exit
+                  end if
+                end do
+              end if
+            end do
+            ! Zero out any remaining entries above iVarChannel (if any)
+            if (iVarChannel < size(varChannels)) then
+              ChannelIndicesVar(iObs, (iVarChannel+1):size(varChannels)) = 0
+            end if
+          end do
+          Ob % ChanNum = ChannelIndicesVar
       else
         if (compressChannels) then
           Ob % ChanNum = ChannelIndices
@@ -1361,8 +1398,32 @@ subroutine opsinputs_varobswriter_fillchannumandnumchans( &
           Ob % ChanNum = ChannelIndices
         end if
       end if
-    else if (varObsSize_loc == size(channels)) then
-      if (size(varChannels) > 0) then
+    else
+      ! varObsSize_loc > 0 and <= size(channels): covers both the case where the varobs
+      ! array is sized to size(varChannels) (the natural subset case, varObsSize_loc == size(varChannels))
+      ! and the case where it equals size(channels). The sub-branches below guard independently.
+      if (size(varChannels) > 0 .and. size(varChannels) < size(channels)) then
+        ! varChannels is a true subset of channels: look up each passing channel in varChannels
+        ! and store the actual channel number at the next compact ChanNum slot.
+        do iObs = 1, Ob % Header % NumObsLocal
+          iVarChannel = 0
+          do iChannel = 1, ChannelCounts(iObs)
+            if (ChannelIndices(iObs, iChannel) > 0 .and. &
+                ChannelIndices(iObs, iChannel) <= size(channels)) then
+              do array_loop = 1, size(varChannels)
+                if (channels(ChannelIndices(iObs, iChannel)) == varChannels(array_loop)) then
+                  if (iVarChannel < size(varChannels)) then
+                    iVarChannel = iVarChannel + 1
+                    ChannelIndicesVar(iObs, iVarChannel) = varChannels(array_loop)
+                  end if
+                  exit
+                end if
+              end do
+            end if
+          end do
+        end do
+        Ob % ChanNum = ChannelIndicesVar
+      else if (size(varChannels) > 0) then
         do iChannel=1,  NumChannels
           if (compressChannels) then
             do iObs=1, Ob % Header % NumObsLocal
@@ -1384,7 +1445,18 @@ subroutine opsinputs_varobswriter_fillchannumandnumchans( &
 
 if (FillNumChans) then
   call Ops_Alloc(Ob % Header % NumChans, "NumChans", Ob % Header % NumObsLocal, Ob % NumChans)
-  Ob % NumChans = ChannelCounts
+  ! When ChanNum is restricted to varChannels (a strict subset of channels), NumChans must
+  ! count only the QC-passing channels that are also in varChannels — not all QC-passing
+  ! channels from the full channels list (ChannelCounts). If NumChans > size(varChannels)
+  ! then VAR would read ChanNum out of bounds.
+  if (FillChanNum .and. associated(Ob % ChanNum) .and. &
+      size(varChannels) > 0 .and. size(varChannels) < size(channels) .and. varObsSize_loc /= 0) then
+    do iObs = 1, Ob % Header % NumObsLocal
+      Ob % NumChans(iObs) = count(Ob % ChanNum(iObs, :) > 0)
+    end do
+  else
+    Ob % NumChans = ChannelCounts
+  end if
 end if
 end subroutine opsinputs_varobswriter_fillchannumandnumchans
 

test/CMakeLists.txt

@@ -351,6 +351,10 @@ ADD_WRITER_TEST(NAME     varobswriter_globalnamelist_seviriclr
                 YAML     varobswriter_globalnamelist_seviriclr.yaml
                 NAMELIST ../../etc/global/varobs/SEVIRIClr.nl
                 DATA     varobs_globalnamelist_seviriclr.nc4)
+ADD_WRITER_TEST(NAME     varobswriter_varChanneltest
+                YAML     varobswriter_varChanneltest.yaml
+                NAMELIST ../../etc/global/varobs/SEVIRIClr.nl
+                DATA     varobs_globalnamelist_seviriclr.nc4)
 ADD_WRITER_TEST(NAME     varobswriter_globalnamelist_mtgirs
                 YAML     varobswriter_globalnamelist_mtgirs.yaml
                 NAMELIST ../../etc/global/varobs/MTGIRS.nl
@@ -375,7 +379,15 @@ ADD_WRITER_TEST(NAME     varobswriter_globalnamelist_epsmws
                 YAML     varobswriter_globalnamelist_epsmws.yaml
                 NAMELIST ../../etc/global/varobs/EPSMWS.nl
                 DATA     varobs_globalnamelist_epsmws.nc4)
-
+
+# Verifies ChanNum and NumChans consistency when varChannels is a strict subset of channels.
+# ChanNum must have only size(varChannels) levels (no IMDI padding) and NumChans must count
+# only QC-passing channels that appear in varChannels.
+ADD_WRITER_TEST(NAME     varobswriter_varChanneltest_checker
+                YAML     varobswriter_varChanneltest_checker.yaml
+                NAMELIST VarObsWriterNamelists_varobswriter_varChanneltest_checker/SEVIRIClr.nl
+                DATA     varobs_globalnamelist_seviriclr.nc4)
+
 # Tests the UKV namelist files in the etc directory
 
 ADD_WRITER_TEST(NAME     varobswriter_ukvnamelist_seviviasr

test/testinput/VarObsWriterNamelists_varobswriter_varChanneltest_checker/SEVIRIClr.nl

@@ -0,0 +1,3 @@
+&VarobsControlNL
+Varfields=54,55
+/

test/testinput/varobswriter_varChanneltest

@@ -0,0 +1,23 @@
+time window:
+  begin: 2018-01-01T00:00:00Z
+  end: 2018-01-01T02:00:00Z
+
+observations:
+  - obs space:
+      name: SEVIRIClr
+      obsdatain:
+        engine:
+          type: H5File
+          obsfile: Data/varobs_globalnamelist_seviriclr.nc4
+      simulated variables: [brightnessTemperature]
+      channels: 1, 3
+    obs filters:
+      - filter: Reset Flags to Pass
+        flags_to_reset: [10, 15]
+      - filter: VarObs Writer
+        namelist_directory: ../etc/global/varobs
+        general_mode: debug
+        varChannels: [1]   # intentionally fewer than obs space channels (1,3)
+    HofX: ObsValue
+    benchmarkFlag: 1000
+    flaggedBenchmark: 0

test/testinput/varobswriter_varChanneltest.yaml

@@ -0,0 +1,23 @@
+time window:
+  begin: 2018-01-01T00:00:00Z
+  end: 2018-01-01T02:00:00Z
+
+observations:
+  - obs space:
+      name: SEVIRIClr
+      obsdatain:
+        engine:
+          type: H5File
+          obsfile: Data/varobs_globalnamelist_seviriclr.nc4
+      simulated variables: [brightnessTemperature]
+      channels: 1, 3
+    obs filters:
+      - filter: Reset Flags to Pass
+        flags_to_reset: [10, 15]
+      - filter: VarObs Writer
+        namelist_directory: ../etc/global/varobs
+        general_mode: debug
+        varChannels: [1]   # intentionally fewer than obs space channels (1,3)
+    HofX: ObsValue
+    benchmarkFlag: 1000
+    flaggedBenchmark: 0

test/testinput/varobswriter_varChanneltest_checker.yaml

@@ -0,0 +1,52 @@
+time window:
+  begin: 2018-01-01T00:00:00Z
+  end: 2018-01-01T02:00:00Z
+
+observations:
+  # Verify that when varChannels is a strict subset of channels:
+  #   - ChanNum (field 55) has exactly size(varChannels) levels — no IMDI padding
+  #   - NumChans (field 54) counts only QC-passing channels that are in varChannels
+  #
+  # Setup: channels 1 and 3; varChannels [1]; size_of_varobs_array 1 (= size(varChannels))
+  # All flags are reset to pass, so both channels 1 and 3 pass QC.
+  # Channel 1 is in varChannels; channel 3 is not.
+  # Expected: ChanNum = [1] (1 level only), NumChans = 1 for every observation.
+  - obs space:
+      name: SEVIRIClr
+      obsdatain:
+        engine:
+          type: H5File
+          obsfile: Data/varobs_globalnamelist_seviriclr.nc4
+      simulated variables: [brightnessTemperature]
+      channels: 1, 3
+    obs filters:
+    - filter: Reset Flags to Pass
+      flags_to_reset: [10, 15]  # missing, Hfailed
+    - filter: VarObs Writer
+      namelist_directory: testinput/VarObsWriterNamelists_varobswriter_varChanneltest_checker
+      general_mode: debug
+      varChannels: [1]
+      size_of_varobs_array: 1
+    - filter: VarObs Checker
+      expected_main_table_columns:
+        # 3 observations × 2 rows each (field 54 + field 55, each with 1 level)
+        # NumChans (54): all observations have 1 channel in varChannels that passes QC
+        # ChanNum (55): 1 level containing channel number 1 (channel 3 is excluded)
+        field:    ["54", "55",
+                   "54", "55",
+                   "54", "55"]
+        level:    ["1", "1",
+                   "1", "1",
+                   "1", "1"]
+        ob value: ["1.00000", "1.00000",
+                   "1.00000", "1.00000",
+                   "1.00000", "1.00000"]
+        lat:      ["7.10000", "7.10000",
+                   "7.30000", "7.30000",
+                   "7.40000", "7.40000"]
+        lon:      ["17.10000", "17.10000",
+                   "17.30000", "17.30000",
+                   "17.40000", "17.40000"]
+    HofX: ObsValue  # placeholder — required to trigger postFilter
+    benchmarkFlag: 1000
+    flaggedBenchmark: 0