Merge pull request #174 from GEOS-ESM/feature/msienkie/prepQC_modific…

…ations

Feature/msienkie/prep qc modifications

src/Applications/GSI_App/gsidiag_bin2txt.f90

@@ -158,8 +158,7 @@ program gsidiag_bin2txt
      call abort
   end if
 
-  write(*,*)'File ', trim(infn), ' opened on lun=',inlun
-!  open(inlun,file=infn,form='unformatted',convert='big_endian')
+  write(*,'(''File '', a, '' opened on lun='',i5 )') trim(infn), inlun  
 
   call read_radiag_header( inlun, npred_read, sst_ret, headfix, headchan, headname, iflag, debug )
 

src/Applications/NCEP_Paqc/GMAOprev/prevents.f

@@ -1,7 +1,7 @@
 C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
 C
 C MAIN PROGRAM: PREPOBS_PREVENTS
-C   PRGMMR: KEYSER           ORG: NP22        DATE: 2013-02-13
+C   PRGMMR: DONG             ORG: NP22        DATE: 2020-01-09
 C
 C ABSTRACT: PREPARES OBSERVATIONAL PREPBUFR FILE FOR SUBSEQUENT
 C   QUALITY CONTROL AND ANALYSIS PROGRAMS.  THIS IS DONE THROUGH THE
@@ -81,6 +81,9 @@
 c rename all REAL(8) variables as
 C     *_8
 
+C 2020-01-06  J. Dong -- In program PREPOBS_PREVENTS, changed the
+C             windowing decade from 20 to 40 for cases when the year 
+C             is represented by 2 digits instead of 4.
 C
 C USAGE:
 C   INPUT FILES:
@@ -153,11 +156,11 @@ PROGRAM PREPOBS_PREVENTS
 
       DATA  LAST/'XXXXXXXX'/
 
-      CALL W3TAGB('PREPOBS_PREVENTS',2013,0044,0061,'NP22')
+      CALL W3TAGB('PREPOBS_PREVENTS',2020,0009,0061,'NP22')
 
       PRINT 700
   700 FORMAT(/'  =====> WELCOME TO PREVENTS PROGRAM -- LAST UPDATED ',
-     $ '2013-02-13'/)
+     $ '2020-01-09'/)
 
 C  On WCOSS should always set BUFRLIB missing (BMISS) to 10E8 to avoid
 C   overflow when either an INTEGER*4 variable is set to BMISS or a
@@ -204,7 +207,9 @@ PROGRAM PREPOBS_PREVENTS
          PRINT'(" ##> 2-DIGIT YEAR IN IDATEP RETURNED FROM READMG ",
      $    "(IDATEP IS: ",I0,") - USE WINDOWING TECHNIQUE TO OBTAIN ",
      $    "4-DIGIT YEAR")', IDATEP
-         IF(IDATEP/1000000.GT.20)  THEN
+C IF IDATEP=41~99 THEN IDATEP=1941~1999
+C IF IDATEP=00~40 THEN IDATEP=2000~2040
+         IF(IDATEP/1000000.GT.40)  THEN
             IDATEP = 1900000000 + IDATEP
          ELSE
             IDATEP = 2000000000 + IDATEP

src/Applications/NCEP_Paqc/combine_bfr/CMakeLists.txt

@@ -22,6 +22,11 @@ ecbuild_add_executable (
   SOURCES scanbuf0.f
   LIBS NCEP_bufr_r4i4 GMAO_mpeu)
 
+ecbuild_add_executable (
+  TARGET scanbuf0_accum.x
+  SOURCES scanbuf0_accum.f
+  LIBS NCEP_bufr_r4i4 GMAO_mpeu)
+
 ecbuild_add_executable (
   TARGET scanbuf2.x
   SOURCES scanbuf2.f
@@ -35,4 +40,4 @@ ecbuild_add_executable (
 ecbuild_add_executable (
   TARGET cp_2ssi.x
   SOURCES cp_2ssi.f
-  LIBS NCEP_bufr_r4i4 GMAO_mpeu)
+  LIBS NCEP_bufr_r4i4 GMAO_mpeu)

src/Applications/NCEP_Paqc/combine_bfr/scanbuf0_accum.f

@@ -0,0 +1,133 @@
+      program scanbuf_accum
+
+      implicit none
+
+!
+!  Scan NCEP BUFR files and write out how many reports of each type
+!  This version saves counts for each subset types and writes out a 
+!  cumulative count of each type at the end.  
+!
+      integer,parameter :: maxsubs = 15
+
+      character*8 subset, saved        ! subset names (current & prev.)
+      character*55 descr               ! Table A description of subset
+      character*255 cfile, argv        ! file name from command line
+      integer idat10                   ! 10 digit date/time from subset
+      integer iret                     ! return code
+      integer lunit                    ! input unit number
+      integer lprint                   ! output unit number
+      integer argc                     ! used to get args from command line
+      integer knt                      ! count of records in current subset
+      integer kmsg, ksub
+      integer nmsub
+
+      character*8 subs(maxsubs)        ! names for cumulative counts
+      integer knts(maxsubs)            ! cumulative counts per subset type
+      integer nsubs                    ! number of unique subsets types found
+      integer ii, i
+
+      integer*4 iargc
+
+      lunit = 35                       !  input data file
+
+
+
+      argc = iargc()
+      if ( argc < 1 ) then
+         print *, 'program needs a BUFR filename as input'
+         stop
+      endif
+      call GetArg ( 1_4, argv )
+      cfile = argv
+      open( unit=lunit, file=cfile,form='unformatted')
+      if (argc .ge. 2) then
+! second arg is output print file
+        call GetArg ( 2_4, argv )
+        lprint = 36
+        open( unit=lprint,file=argv,form='formatted')
+      else
+        lprint = 6
+      endif
+
+      subs = '        '
+      knts = 0
+      nsubs = 0
+
+      call datelen(10)
+      CALL OPENBF(LUNIT,'IN',LUNIT)
+      call readmg(lunit,subset,idat10,iret)
+      write(lprint,*) 'date:',idat10, iret
+      saved = subset
+      knt = 0
+      do while (iret .eq. 0)
+        ksub = nmsub(lunit)
+        knt = knt + ksub
+        call readmg(lunit,subset,idat10,iret)
+        if (subset .ne. saved) then 
+!           if (knt .gt. 0) write(lprint,'(a8,i8)') saved,knt
+           if (knt .gt. 0) then
+              if (nsubs < 1) then
+                 nsubs = 1
+                 subs(nsubs) = saved
+                 knts(nsubs) = knt
+              else
+                 ii = 0
+                 do i = 1,nsubs
+                    if (saved .eq. subs(i)) then
+                       ii = i
+                       exit
+                    end if
+                 end do
+                 if (ii .ne. 0) then
+                    knts(ii) = knts(ii) + knt
+                 else
+                    nsubs = nsubs + 1
+                    if (nsubs .gt. maxsubs) then
+                       print *,'too many unique subsets'
+                       print *,'recompile with larger maxsubs'
+                       stop
+                    end if
+                    subs(nsubs) = saved
+                    knts(nsubs) = knt
+                 end if
+              end if
+           end if
+
+           knt = 0
+           saved = subset
+        endif
+      enddo
+!      if (knt .gt. 0) write(lprint,'(a8,i8)') saved,knt
+      if (knt .gt. 0) then
+         if (nsubs < 1) then
+            nsubs = 1
+            subs(nsubs) = saved
+            knts(nsubs) = knt
+         else
+            ii = 0
+            do i = 1,nsubs
+               if (saved .eq. subs(i)) then
+                  ii = i
+                  exit
+               end if
+            end do
+            if (ii .ne. 0) then
+               knts(ii) = knts(ii) + knt
+            else
+               nsubs = nsubs + 1
+               if (nsubs .gt. maxsubs) then
+                  print *,'too many unique subsets'
+                  print *,'recompile with larger maxsubs'
+                  stop
+               end if
+               subs(nsubs) = saved
+               knts(nsubs) = knt
+            end if
+         end if
+      end if
+      do i = 1,nsubs
+         write(lprint,'(a8,i8)') subs(i),knts(i)
+      end do
+      stop
+      end
+

src/Applications/NCEP_Paqc/combine_bfr/scanbuf2.f

@@ -55,12 +55,12 @@ program scanbuf
         knt = knt + ksub
         call readmg(lunit,subset,idat10,iret)
         if (subset .ne. saved) then 
-           if (knt .gt. 0) write(lprint,'(a8,i8)') saved,knt
+           if (knt .gt. 0) write(lprint,'(a8,i10)') saved,knt
            knt = 0
            saved = subset
         endif
       enddo
-      if (knt .gt. 0) write(lprint,'(a8,i8)') saved,knt
+      if (knt .gt. 0) write(lprint,'(a8,i10)') saved,knt
       stop
       end
 

src/Applications/NCEP_Paqc/modify_bufr/CMakeLists.txt

@@ -11,4 +11,14 @@ ecbuild_add_executable (
 ecbuild_add_executable (
   TARGET explode.x
   SOURCES explode.f
-  LIBS NCEP_bufr_r4i4)
+  LIBS NCEP_bufr_r4i4)
+
+ecbuild_add_executable (
+  TARGET twindow.x
+  SOURCES twindow.f
+  LIBS NCEP_bufr_r4i4 NCEP_w3_r4i4 GMAO_mpeu)
+
+if (EXTENDED_SOURCE)
+  set_target_properties (twindow.x PROPERTIES COMPILE_FLAGS ${EXTENDED_SOURCE})
+endif()
+

src/Applications/NCEP_Paqc/modify_bufr/fix_ascat.f

@@ -130,8 +130,8 @@ program fix_ascat
                mod = .false.
                do j = 1,klev
                   if ( evn(3,j) .eq. 9. ) then
-                     if ( abs(evn(3,j)) .lt. wmax .and. 
-     &                    abs(evn(4,j)) .lt. wmax ) then
+                     if ( abs(evn(1,j)) .lt. wmax .and. 
+     &                    abs(evn(2,j)) .lt. wmax ) then
                         mod = .true.
                         evn(3,j) = 2.
                         evn(4,j) = 1.