C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM: PREPOBS_PREVENTS
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
C   FOLLOWING: INTERPOLATION OF GLOBAL SPECTRAL SIGMA OR HYBRID FIRST
C   GUESS TO PREPBUFR OBSERVATION LOCATIONS WITH ENCODING OF FIRST
C   GUESS VALUES INTO PREPBUFR REPORTS; ENCODING OF "PREVENT" AND/OR
C   "VIRTMP" EVENTS INTO PREPBUFR REPORTS; AND ENCODING OF OBSERVATION
C   ERRORS FROM THE ERROR SPECIFICATION FILE INTO PREPBUFR REPORTS.
C   FOR MORE INFORMATION ON THE DETAILS OF THE "PREVENT" AND "VIRTMP"
C   EVENTS, SEE THE DOCBLOCK FOR EITHER W3NCO ROUTINE "GBLEVENTS"
C   (WHICH CURRENTLY READS SIGMA OR HYBRID FIRST GUESS IN ALL NETWORKS
C   EXCEPT "cdas" or "cdc") OR FOR IN-LINE ROUTINE GBLEVENTS_CDAS
C   (WHICH CURRENTLY READS SIGMA GUESS IN "cdas" or "cdc" NETWORKS).
C   THIS PROGRAM CALLS GBLEVENTS OR GBLEVENTS_CDAS, WHICH RUNS HERE IN
C   THE "PREVENTS" MODE.  W3NCO ROUTINE GBLEVENTS (OR IN-LINE ROUTINE
C   GBLEVENTS_CDAS) DOES THE BULK OF THE WORK HERE.  AFTER EACH REPORT
C   IS UPDATED BY GBLEVENTS/GBLEVENTS_CDAS, IT IS WRITTEN OUT TO A
C   "PREPROCESSED" VERSION OF THE PREPBUFR FILE.  
C
C PROGRAM HISTORY LOG:
C 1994-01-06  J. WOOLLEN  ORIGINAL VERSION FOR REANALYSIS
C 1994-09-06  J. WOOLLEN  VERSION FOR IMPLEMENTATION IN GBL SYSTEM
C 1997-10-07  D.A. KEYSER -- ADDED NAMELIST SWITCH TO BYPASS VIRT.
C             TEMPERATURE EVENT FOR NON-RADIOSONDE/SATSND DATA TYPES
C             (INVOKED IN RUC VERSION - TOB NOT CHANGED FROM INPUT)
C 1997-11-24  D.A. KEYSER -- ADDED NAMELIST SWITCH "REDUCE" TO BYPASS
C             ALL PREVENTS PROCESSING (IF TRUE) FOR MESSAGE TYPES NOT
C             EQUAL TO "ADPUPA", "AIRCFT" AND "PROFLR"
C 1998-02-03  D.A. KEYSER -- CORRECTED ERROR FROM PREVIOUS CHANGE THAT
C             RESULTED IN BYPASSING THE VIRT. TEMPERATURE EVENT FOR
C             "ADPUPA" AND "SFCSHP" TYPES WHEN N-LIST SWITCH "REDUCE"
C             IS TRUE - REDUCE=TRUE WILL NOW CONTINUE TO DO ALL
C             PREVENTS PROCESSING FOR MESSAGE TYPES "ADPUPA", "AIRCFT",
C             "PROFLR" AS WELL AS NOW "ADPSFC" AND "SFCSHP"
C 1998-08-25  D.A. KEYSER -- ADDED SWITCHES 'DOBERR' AND 'DOFCST' IN
C             NAMELIST READ FROM DATA CARDS; SUBROUTINE NOW Y2K AND
C             FORTRAN 90 COMPLIANT
C 1998-09-14  J.WOOLLEN - ADDED SWITCH FOR INSTALLING ANALYSED VALUES
C 1998-09-17  D.A. KEYSER -- PROGRAM NOW CALLS EXIT PRIOR TO STOP FOR
C             NON-ZERO EXIT STATES (TRANSFERS EXIT STATE TO UNIX
C             FOREGROUND STATUS CODE)
C 1998-09-21  D. A. KEYSER -- SUBROUTINE NOW Y2K AND FORTRAN 90
C             COMPLIANT
C 1998-07-06  D. A. KEYSER -- MODIFIED TO COMPILE AND RUN ON IBM;
C             NOW CALLS NEW W3LIB ROUTINE "GBLEVENTS" TO PERFORM
C             MOST OF THE FUNCTIONS THAT THIS PROGRAM USED TO DO
C             (THIS W3LIB ROUTINE IS ALSO CALLED BY PREPDATA,
C             SYNDATA AND POSTEVENTS), ONLY THE READING IN OF
C             REPORTS IS DONE BY THIS MAIN PROGRAM NOW
C 1999-09-26  D. A. KEYSER -- CHANGES TO MAKE CODE MORE PORTABLE
C 2001-02-02  D. A. KEYSER -- MINOR HOUSKEEPING CHANGES; PICKS UP AN
C             UPDATED W3LIB ROUTINE GBLEVENTS
C 2001-10-10  D. A. KEYSER -- MODIFIED TO NOW PASS TWO SPANNING GLOBAL
C             SIGMA GUESS FILES INTO W3LIB ROUTINE GBLEVENTS IN
C             SITUATIONS WHERE THE CENTER DATE FOR THE PREPBUFR FILE
C             HAS AN HOUR THAT IS NOT A MULTIPLE OF 3 (SEE 2001-10-10
C             CHANGES TO GBLEVENTS)
C 2007-11-20  D. A. KEYSER -- CHECK NETWORK WHICH THIS CODE IS RUNNING
C             UNDER (VIA CALL TO SYSTEM ROUTINE "GETENV") - IF NETWORK
C             IS NOT "cdas" OR "cdc", CALL W3LIB ROUTINE GBLEVENTS AS
C             BEFORE, IF NETWORK IS "cdas" OR "cdc", CALL NEW IN-LINE
C             ROUTINE GBLEVENTS_CDAS WHICH IS A FROZEN VERSION OF THE
C             2006-07-14 VERSION OF GBLEVENTS NEEDED TO READ THE CDAS-
C             STYLE SIGMA FIRST GUESS (THE NEW SIGIO VERSION OF W3LIB
C             ROUTINE GBLEVENTS CANNOT READ THE OLD CDAS-STYLE SIGMA
C             FIRST GUESS)
C 2012-11-20  J. WOOLLEN   -- INITIAL PORT TO WCOSS 
C 2013-02-13  D. A. KEYSER -- FINAL CHANGES TO RUN ON WCOSS: SET
C             BUFRLIB MISSING (BMISS) TO 10E8 RATHER THAN 10E10 TO
C             AVOID INTEGER OVERFLOW;  REPLACED GETENV WITH MORE
C             STANDARD GET_ENVIRONMENT_VARIABLE; USE FORMATTED PRINT
C             STATEMENTS WHERE PREVIOUSLY UNFORMATTED PRINT WAS > 80
C             CHARACTERS
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:
C     UNIT 05  - STANDARD INPUT (DATA CARDS - SEE NAMELIST
C                DOCUMENTATION IN W3NCO ROUTINE GBLEVENTS OR IN-LINE
C                ROUTINE GBLEVENTS_CDAS DOCBLOCK)
C     UNIT 11  - PREPBUFR FILE
C     UNIT 12  - FIRST INPUT SPECTRAL (GLOBAL) SIGMA OR HYBRID FIRST
C                GUESS FILE; IF HOUR IN CENTER DATE FOR PREPBUFR FILE
C                IS A MULTIPLE OF 3 THEN THIS FILE IS VALID AT THE
C                CENTER DATE OF THE PREPBUFR FILE, IF THE HOUR IN
C                CENTER DATE FOR PREPBUFR FILE IS NOT A MULTIPLE OF 3
C                THEN THIS FILE IS VALID AT THE CLOSEST TIME PRIOR TO
C                THE CENTER DATE OF THE PREPBUFR FILE THAT IS A
C                MULTIPLE OF 3
C     UNIT 13  - SECOND INPUT SPECTRAL (GLOBAL) SIGMA OR HYBRID FIRST
C                GUESS FILE; IF HOUR IN CENTER DATE FOR PREPBUFR FILE
C                IS A MULTIPLE OF 3 THEN THIS FILE IS EMPTY, IF THE
C                HOUR IN CENTER DATE FOR PREPBUFR FILE IS NOT A
C                MULTIPLE OF 3 THEN THIS FILE IS VALID AT THE CLOSEST
C                TIME AFTER THE CENTER DATE OF THE PREPBUFR FILE THAT
C                IS A MULTIPLE OF 3
C     UNIT 14  - OBSERVATION ERROR FILE
C     UNIT 15  - EXPECTED CENTER DATE IN PREPBUFR FILE IN FORM
C                YYYYMMDDHH
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C     UNIT 51  - PREPBUFR FILE (NOW CONTAINING FIRST GUESS VALUES,
C              - "PREVENT" AND "VIRTMP" EVENTS, AND OBERVATIONAL ERROR
C              - VALUES)
C     UNIT 52  - "PREVENT" EVENTS DATA FILTERING SUMMARY PRINT FILE
C
C   SUBPROGRAMS CALLED:
C       UNIQUE   - GBLEVENTS_CDAS
C       W3NCO    - W3TAGB    W3TAGE    ERREXIT
C       W3EMC    - GBLEVENTS
C       BUFRLIB  - DATELEN   OPENBF    READMG    OPENMB
C                - WRITSB    CLOSBF    SETBMISS  GETBMISS
C       SYSTEM   - GET_ENVIRONMENT_VARIABLE
C
C   EXIT STATES:
C     COND =   0 - SUCCESSFUL RUN
C     COND =  21 - DATE DISAGREEMENT BETWEEN ACTUAL CENTER DATE IN
C                  PREPBUFR FILE AND EXPECTED CENTER DATE READ IN
C                  FROM UNIT 15
C     COND =  22 - BAD OR MISSING DATE READ IN FROM UNIT 15
C     COND =  60-79 - RESERVED FOR W3NCO ROUTINE GBLEVENTS OR IN-LINE
C                      ROUTINE GBLEVENTS_CDAS (SEE GBLEVENTS/
C                      GBLEVENTS_CDAS DOCBLOCK)
C
C
C REMARKS: NONE.
C
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      PROGRAM PREPOBS_PREVENTS

      REAL(8)   BMISS,GETBMISS

      CHARACTER*4  NET
      CHARACTER*8  SUBSET,LAST

      DIMENSION IUNITG(2)

      DATA  LAST/'XXXXXXXX'/

      CALL W3TAGB('PREPOBS_PREVENTS',2020,0283,0061,'NP22')

      PRINT 700
  700 FORMAT(/'  =====> WELCOME TO PREVENTS PROGRAM -- LAST UPDATED ',
     $ '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
C   REAL*8 (or REAL*4) variable that is missing is NINT'd
C  -------------------------------------------------------------------
ccccc CALL SETBMISS(10E10_8)
      CALL SETBMISS(10E8_8)
      BMISS=GETBMISS()
      print *
      print *, 'BUFRLIB value for missing is: ',bmiss
      print *

      IUNITI    = 11
      IUNITG(1) = 12
      IUNITG(2) = 13
      IUNITE    = 14
      IUNITD    = 15
      IUNITP    = 51
      IUNITS    = 52

C  OPEN INPUT PREPBUFR FILE JUST TO GET MESSAGE DATE (WHICH IS THE
C   ACTUAL CENTER DATE), LATER CLOSE FILE
C  ---------------------------------------------------------------

      CALL DATELEN(10)

      CALL OPENBF(IUNITI,'IN',IUNITI)
      CALL READMG(IUNITI,SUBSET,IDATEP,IRET)

      PRINT 53, IDATEP
   53 FORMAT(/' --> ACTUAL   CENTER DATE OF PREPBUFR FILE READ FROM ',
     $ ' SEC. 1 MESSAGE DATE IS:',I11/)

      IF(IDATEP.LT.1000000000)  THEN

C If 2-digit year returned in IDATEP, must use "windowing" technique
C  to create a 4-digit year

C IMPORTANT: IF DATELEN(10) IS CALLED, THE DATE HERE SHOULD ALWAYS
C            CONTAIN A 4-DIGIT YEAR, EVEN IF INPUT FILE IS NOT
C            Y2K COMPLIANT (BUFRLIB DOES THE WINDOWING HERE)

         PRINT *, '##> THE FOLLOWING SHOULD NEVER HAPPEN!!!!!'
         PRINT'(" ##> 2-DIGIT YEAR IN IDATEP RETURNED FROM READMG ",
     $    "(IDATEP IS: ",I0,") - USE WINDOWING TECHNIQUE TO OBTAIN ",
     $    "4-DIGIT YEAR")', IDATEP
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
         ENDIF
         PRINT *, '##> CORRECTED IDATEP WITH 4-DIGIT YEAR, IDATEP NOW',
     $    ' IS: ',IDATEP
      ENDIF

C  READ IN EXPECTED CENTER DATE OF PREPBUFR FILE
C  ---------------------------------------------

      REWIND IUNITD
      READ(IUNITD,'(6X,I10)',END=904,ERR=904)  IDATED
      PRINT 3, IUNITD, IDATED
    3 FORMAT(/' --> EXPECTED CENTER DATE OF PREPBUFR FILE READ FROM ',
     $ 'UNIT',I3,' IS:',13X,I11/)

C  CHECK ACTUAL CENTER DATE OF PREPBUFR FILE VS. EXPECTED CENTER DATE
C  ------------------------------------------------------------------

      IF(IDATEP.NE.IDATED)  GO TO 901

      CALL CLOSBF(IUNITI)

C  OPEN INPUT AND OUTPUT PREPBUFR FILES FOR DATA PROCESSING
C  --------------------------------------------------------

      CALL OPENBF(IUNITI,'IN ',IUNITI)
      CALL OPENBF(IUNITP,'OUT',IUNITI)

C  DETERMINE WHICH NETWORK WE ARE RUNNING UNDER
C  --------------------------------------------

      CALL GET_ENVIRONMENT_VARIABLE('NET',NET)

      print *
      if(net.eq.'cdas' .or. net.eq.'cdc') then
         print'(" --> Running in ",A," network - CALL IN-LINE ROUTINE ",
     $    "GBLEVENTS_CDAS (expects CDAS-style sigma guess)")', net
      else
         print'(" --> Running in ",A," network - CALL W3NCO ROUTINE ",
     $    "GBLEVENTS (expects GFS-style sigma or hybrid guess)")', net
      end if
      print *

C----------------------------------------------------------------------
C----------------------------------------------------------------------

      NEWTYP = 0

C  LOOP THROUGH THE INPUT MESSAGES
C  -------------------------------

      DO WHILE(IREADMG(IUNITI,SUBSET,JDATEP).EQ.0)
         IF(SUBSET.NE.LAST)  THEN
            NEWTYP = 1
cppppp
            print *, 'New input message type read in: ',SUBSET
cppppp
         END IF

         CALL OPENMB(IUNITP,SUBSET,JDATEP)
         DO WHILE(IREADSB(IUNITI).EQ.0)

C  COPY DECODED REPORT FROM INPUT PREPBUFR FILE TO OUTPUT PREPBUFR FILE
C  --------------------------------------------------------------------

            CALL UFBCPY(IUNITI,IUNITP)

            IF(NET.NE.'cdas' .AND. NET.NE.'cdc') THEN

C  FOR ALL NETWORKS EXCEPT CDAS AND CDC, CALL W3NCO ROUTINE GBLEVENTS
C   TO ENCODE FIRST GUESS VALUES FOR THIS REPORT (EXPECTS GFS-STYLE
C   SIGMA OR HYBRID GUESS)
C  --------------------------------------------------------------------

               CALL GBLEVENTS(IDATED,IUNITG,IUNITE,IUNITP,IUNITS,SUBSET,
     $                        NEWTYP)

            ELSE

C  FOR CDAS NETWORK, CALL IN-LINE ROUTINE GBLEVENTS_CDAS TO ENCODE
C   FIRST GUESS VALUES FOR THIS REPORT (EXPECTS CDAS-STYLE SIGMA GUESS)
C  --------------------------------------------------------------------

               CALL GBLEVENTS_CDAS(IDATED,IUNITG,IUNITE,IUNITP,IUNITS,
     $                             SUBSET,NEWTYP)

            END IF

C  WRITE THIS REPORT (SUBSET) INTO BUFR MESSAGE IN OUTPUT PREPBUFR FILE
C  --------------------------------------------------------------------

            CALL WRITSB(IUNITP)

            NEWTYP = 0

         ENDDO

         LAST = SUBSET

      ENDDO

C  CLOSE THE BUFR FILES
C  --------------------

      CALL CLOSBF(IUNITI)
      CALL CLOSBF(IUNITP)

C  ALL DONE
C  --------

      CALL W3TAGE('PREPOBS_PREVENTS')

      STOP
C-----------------------------------------------------------------------

  901 CONTINUE
      PRINT 9901, IDATEP,IDATED
 9901 FORMAT(/' ##> ACTUAL CENTER DATE OF INPUT PREPBUFR FILE (',I10,
     $ ') DOES NOT MATCH EXPECTED CENTER DATE (',I10,') - STOP 21'/)
      CALL W3TAGE('PREPOBS_PREVENTS')
      CALL ERREXIT(21)

C-----------------------------------------------------------------------

  904 CONTINUE
      PRINT 9902, IUNITD
 9902 FORMAT(/' ##> BAD OR MISSING EXPECTED PREPBUFR CENTER DATE ',
     $ 'READ FROM UNIT',I3,' - STOP 22'/)
      CALL W3TAGE('PREPOBS_PREVENTS')
      CALL ERREXIT(22)

C-----------------------------------------------------------------------

      END
