SUBROUTINE OPFCSTID(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA,
     1                  ID,IDPARS,JD,ITAU,
     2                  NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NCAT,NSTA,
     3                  ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
     4                  LSTORE,ND9,LITEMS,CORE,ND10,
     5                  NBLOCK,NFETCH,
     6                  IS0,IS1,IS2,IS4,ND7,
     7                  L3264B,L3264W,ISTAB,IER)
C 
C        OCTOBER   2016   SCHNAPP  NEW ROUTINE - ADAPTED FROM OPFCST
C        NOVEMBER  2018   SAMPLATSKY   ADDED PROCESSING FOR POP IDS,
C                                      ALSO ADDED EXCEPTION FOR POP
C                                      PROCESSING WITH FETCHING THE
C                                      "BACKUP" FORECASTS.
C        JANUARY   2020   HUANG        ADDED PROCESSING FOR MELD SKY
C                                      COVER. 
C        JULY      2020   HUANG        ADDED CCIG/CVIS MELD. 
C        OCTOBER   2022   SHAFER       ADDED MELD T/D/W
C        FEBRUARY  2023   HUANG        ADDED 15MIN C&V IDs, INCREASED 
C                                      NDIM TO 24. 
C
C        PURPOSE 
C            TO AUGMENT PRIMARY FORECASTS WITH SECONDARY (BACKUP) FORECASTS
C            WHEN FORECASTS FROM A PRIMARY ID ARE NOT PRESENT.
C
C        DATA SET USE 
C            KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE.
C                     (OUTPUT) 
C            KFIL10 - UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS.
C                     (INPUT-OUTPUT) 
C            IP12   - INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF
C                     STATIONS ON THE INPUT FILES WILL BE PRINTED TO 
C                     THE FILE WHOSE UNIT NUMBER IS IP12.  (OUTPUT)
C         KFILRA(J) - THE UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES
C                     ARE AVAILABLE (J=1,NUMRA).  (INPUT)
C 
C        VARIABLES 
C              KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE.
C                       (INPUT) 
C              KFIL10 = UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS.
C                       (INPUT)
C                IP12 = INDICATES WHETHER (>0) OR NOT (=0) THE LIST OF
C                       STATIONS ON THE EXTERNAL RANDOM ACCESS FILES
C                       WILL BE LISTED TO UNIT IP12.  (INPUT)
C           KFILRA(J) = THE UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES
C                       ARE AVAILABLE (J=1,NUMRA).  (INPUT)
C           RACESS(J) = THE FILE NAMES ASSOCIATED WITH KFILRA(J) (J=1,NUMRA).
C                       (CHARACTER*60)  (INPUT)
C               NUMRA = THE NUMBER OF VALUES IN KFILRA( ) AND RACESS( ).
C                       (INPUT)
C             ID(J,L) = THE PREDICTOR IDS (J=1,4) (L=1,NCAT).  (INPUT)
C         IDPARS(J,L) = THE PARSED, INDIVIDUAL COMPONENTS OF THE 
C                       PREDICTOR ID CORRESPONDING TO ID( ) (J=1,15)
C                       (L=1,NCAT).  (INPUT)
C                       J=1--CCC (CLASS OF VARIABLE),
C                       J=2--FFF (SUBCLASS OF VARIABLE),
C                       J=3--B (BINARY INDICATOR),
C                       J=4--DD (DATA SOURCE, MODEL NUMBER),
C                       J=5--V (VERTICAL APPLICATION),
C                       J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY 
C                            1 LAYER),
C                       J=7--LTLTLTLT (TOP OF LAYER),
C                       J=8--T (TRANSFORMATION),
C                       J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK IN 
C                            TIME),
C                       J=10--OT (TIME APPLICATION),
C                       J=11--OH (TIME PERIOD IN HOURS),
C                       J=12--TAU (PROJECTION IN HOURS),
C                       J=13--I (INTERPOLATION TYPE),
C                       J=14--S (SMOOTHING INDICATOR), AND
C                       J=15--G (GRID INDICATOR).
C             JD(J,L) = THE BASIC INTEGER PREDICTOR IDS (J=1,4) (L=1,NCAT).
C                       THIS IS THE SAME AS ID(J), EXCEPT THAT THE
C                       PORTIONS PERTAINING TO PROCESSING ARE OMITTED:
C                       B = IDPARS(3),
C                       T = IDPARS(8),
C                       I = IDPARS(13),
C                       S = IDPARS(14),
C                       G = IDPARS(15), AND
C                       THRESH.
C                       JD( ) IS USED TO IDENTIFY THE BASIC MODEL FIELDS
C                       AS READ FROM THE ARCHIVE.  (INPUT)
C                ITAU = THE NUMBER OF HOURS AHEAD TO FIND A VARIABLE.
C                       THIS HAS ALREADY BEEN CONSIDERED IN MDATE, BUT
C                       IS NEEDED FOR CALL TO RETVEC.  (INPUT)
C               NDATE = THE DATE/TIME FOR WHICH PREDICTOR IS NEEDED.
C                       (INPUT)
C               MDATE = NDATE UPDATED WITH ITAU( ).  (INPUT)
C          CCALL(K,J) = 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT
C                       LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE
C                       OUTPUT FOR (J=1) AND 5 POSSIBLE OTHER STATION
C                       CALL LETTERS (J=2,6) THAT CAN BE USED INSTEAD
C                       IF THE PRIMARY (J=1) STATION CANNOT BE FOUND 
C                       IN AN INPUT DIRECTORY (K=1,NSTA).  ALL STATION
C                       DATA ARE KEYED TO THIS LIST, EXCEPT POSSIBLY 
C                       CCALLD( ).  EQUIVALENCED TO ICALL( , , ). 
C                       (CHARACTER*8)  (INPUT)
C           ISDATA(K) = WORK ARRAY (K=1,ND1).  (INTERNAL)
C          XDATA(K,L) = COMPUTED VARIABLE IS RETURNED IN XDATA( , )
C                       (K=1,NSTA) (L=1,NCAT).  (OUTPUT)
C                 ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT 
C                       WITH.  DIMENSION OF XDATA( ).  (INPUT)
C                NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT
C                       WITH.  (INPUT)
C         ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTEGER
C                       VARIABLE (L=1,L3264W) (K=1,ND5).  THIS ARRAY IS USED 
C                       TO READ THE STATION DIRECTORY FROM A MOS-2000
C                       EXTERNAL FILE.  EQUIVALENCED TO CCALLD( ). 
C                       (CHARACTER*8)  (INTERNAL)
C           CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5).  EQUIVALENCED
C                       TO ICALLD( , ).  (INTERNAL)
C                NCAT = NUMBER OF FORECAST CATEGORIES.  (INPUT)
C            IPACK(J) = WORK ARRAY (J=1,ND5).  (INTERNAL)
C            IWORK(J) = WORK ARRAY (J=1,ND5).  (INTERNAL)
C             DATA(K) = WORK ARRAY (J=1,ND5).  (INTERNAL)
C                 ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ).
C                       (INPUT)
C         LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA 
C                       STORED (L=1,12) (J=1,LITEMS).  (INPUT-OUTPUT)
C                       L=1,4--THE 4 ID'S FOR THE DATA.
C                       L=5  --LOCATION OF STORED DATA.  WHEN IN CORE,
C                              THIS IS THE LOCATION IN CORE( ) WHERE
C                              THE DATA START.  WHEN ON DISK, 
C                              THIS IS MINUS THE RECORD NUMBER WHERE 
C                              THE DATA START.
C                       L=6  --THE NUMBER OF 4-BYTE WORDS STORED.
C                       L=7  --2 FOR DATA PACKED IN TDL GRIB, 1 FOR NOT.
C                       L=8  --THE DATE/TIME OF THE DATA IN FORMAT
C                              YYYYMMDDHH.
C                       L=9  --NUMBER OF TIMES DATA HAVE BEEN RETRIEVED.
C                       L=10 --NUMBER OF THE SLAB IN DIR( , ,L) AND
C                              IN NGRIDC( ,L) DEFINING THE 
C                              CHARACTERISTICS OF THIS GRID.
C                       L=11 --THE NUMBER OF THE PREDICTOR IN THE SORTED
C                              LIST IN ID( ,N) (N=1,NPRED) FOR WHICH 
C                              THIS VARIABLE IS NEEDED, WHEN IT IS 
C                              NEEDED ONLY ONCE FROM LSTORE( , ). 
C                              WHEN IT IS NEEDED MORE THAN ONCE, THE 
C                              VALUE IS SET = 7777.
C                       L=12 --USED INITIALLY IN ESTABLISHING 
C                              MOSTORE( , ).  LATER USED AS A WAY OF
C                              DETERMINING WHETHER TO KEEP THIS 
C                              VARIABLE.
C                 ND9 = THE SECOND DIMENSION OF LSTORE( , ).  (INPUT)
C              LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , )
C                       THAT HAVE BEEN USED IN THIS RUN.  (INPUT)
C             CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA 
C                       IDENTIFIED IN LSTORE( , ) (J=1,ND10).  WHEN 
C                       CORE( ) IS FULL DATA ARE STORED ON DISK.
C                       (INPUT)
C                ND10 = DIMENSION OF CORE( ).  (INPUT)
C              NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM
C                       DISK FILE.  (INPUT)
C              NFETCH = THE NUMBER OF TIMES RETVEC HAS BEEN ENTERED.
C                       RETVEC KEEPS TRACK OF THIS AND RETURNS THE
C                       VALUE.  (OUTPUT)
C              IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3). 
C                       (INTERNAL)
C              IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,22+). 
C                       (INTERNAL)
C              IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). 
C                       (INTERNAL)
C              IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). 
C                       (INTERNAL)
C                 ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ).
C                       NOT ALL LOCATIONS ARE USED.  (INPUT)
C              L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING
C                       USED (EITHER 32 OR 64).  (INPUT)
C              L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2).  
C                       CALCULATED BY PARAMETER, BASED ON L3464B.
C                       (INPUT)
C               ISTAB = SET TO 1 WHEN RETURNED VARIABLE IS BINARY;
C                       0 OTHERWISE.  (OUTPUT)
C                 IER = STATUS RETURN.
C                         0 = GOOD RETURN.
C                       SEE RETVEC FOR OTHER VALUES.  (OUTPUT)
C                IERP = HOLDS THE IER VALUE RETURNED FROM THE FIRST CALL
C                       TO RETVEC.  (INTERNAL) 
C               LD(J) = HOLDS THE 4 ID WORDS OF THE DATA FOR PRIMARY
C                       THEN BACKUP FORECASTS.  (INTERNAL)
C           LDPARS(J) = PARSED VALUES CORRESPONDING TO LD( ) (J=1,15)
C                       (INTERNAL)
C          YDATA(K,L) = WORK ARRAY WHICH STORES BACKUP FORECASTS (K=1,ND5).  
C                       (L=1,NCAT) (AUTOMATIC)
C 
C        NONSYSTEM SUBROUTINES CALLED 
C            RETVEC, PRSID1
C
C      PARAMETER (NDIM=13)
      PARAMETER (NDIM=24)
      CHARACTER*8 CCALL(ND1,6)
      CHARACTER*8 CCALLD(ND5)
      CHARACTER*60 RACESS(5)
C
      DIMENSION XDATA(ND1,NCAT),ISDATA(ND1),YDATA(ND1,NCAT)
C        YDATA( ) IS AN AUTOMATIC ARRAY.
      DIMENSION ID(4,NCAT),IDPARS(15,NCAT),JD(4,NCAT)
      DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5)
      DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7)
      DIMENSION LSTORE(12,ND9)
      DIMENSION CORE(ND10),ICALLD(L3264W,ND5)
      DIMENSION LD(4),LDPARS(15),KFILRA(5)
      DIMENSION ITABLE(3,NDIM)
C
      DATA LDPARS/15*0/  
C
C        DEFINE ITABLE WITH FULL WORD IDS TO WORK WITH
      DATA ((ITABLE(I,J),I=1,3),J=1,NDIM)/
C
C      CIG/CIGP   MELD       LAMP
     1 208071035, 208071095, 208071005,
     2 208070235, 208070295, 208070205,
C      VIS/VISP   MELD       LAMP
     3 208131035, 208131095, 208131005,
     4 208130235, 208130295, 208130205,
C      POP        NEW        OLD 
     5 203618135, 203610195, 208620105,
     6 203238135, 203230195, 203220105,
     7 203338135, 203330195, 203330105,
C      OSC/SKYP   MELD       LAMP
     8 208381035, 208381095, 208381005,
     9 208380235, 208380295, 208380205,
C      CCIG/CCIGP   MELD       LAMP
     A 208056035, 208056095, 208056005,
     B 208055235, 208055295, 208055205,
C      CVIS/CVISP   MELD       LAMP
     C 208156035, 208156095, 208156005,
     D 208155235, 208155295, 208155205,
C      TEMP/DEW   MELD       LAMP
     E 202020035, 202020095, 202020005,
     F 203020035, 203020095, 203020005,
C      U/V WIND   MELD       LAMP
     G 204010035, 204010095, 204010005,
     H 204110035, 204110095, 204110005,
C      WIND DIR   MELD       LAMP
     I 204225035, 204225095, 204225005,
C      WIND SPD   MELD       LAMP
     J 204325035, 204325095, 204325005,
C      GUST SPD   MELD       LAMP
     K 204355035, 204355095, 204355005,
C      CIG15MINMELD  MELDPRI  MELDBACKUP
     L 208071095, 208071045, 208071055,
C     CIGP 15MINMELD MELDPRI  MELDBACKUP
     M 208070295, 208070245, 208070255,
C      VIS15MINMELD  MELDPRI  MELDBACKUP
     N 208131095, 208131045, 208131055,
C     VISP 15MINMELD MELDPRI  MELDBACKUP
     O 208130295, 208130245, 208130255/

      IER=0
      IERP=0
C
C        VERIFY THAT NCAT GT 0.
C
      IF(NCAT.LE.0)THEN
         WRITE(KFILDO,80)NCAT
 80      FORMAT(/,' ****NCAT =',I4,' NOT CORRECT IN OPFCSTID.')
         IER=102
         GO TO 300
      ENDIF
C
C        VERIFY THAT OPFCSTID HAS BEEN ENTERED WITH A FORECAST ID
C        THAT IS ACCOMODATED IN ITABLE
C
      DO 90 JJ=1,NDIM
C
      IF((ITABLE(1,JJ)).EQ.(ID(1,1)))EXIT
C        THIS DEFINES THE ELEMENT/ID TO CALCULATE. DON'T CHANGE JJ
C        AFTER EXIT FROM LOOP 90
      IF (JJ.EQ.NDIM)THEN
         WRITE(KFILDO,88)(ID(L,1),L=1,4)
 88      FORMAT(' ****OPFCSTID ENTERED FOR VARIABLE',
     1        2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3,
     2        ' NOT ACCOMMODATED.')
         IER=102
         GO TO 300
      ENDIF
 90   CONTINUE
C
C        DETERMINE WHETHER THE PRIMARY FORECASTS 
C        ARE PRESENT.  IF SO, KEEP THEM.
C        
      LD(1)=ID(1,1)
      LD(2)=ID(2,1)
      LD(3)=ID(3,1)
C
      DO 85 N=1,NCAT
C
      LD(4)=ID(4,N)
C      
      CALL PRSID1(KFILDO,LD,LDPARS)      
      CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA,
     1            LD,LDPARS,JD,ITAU,
     2            NDATE,MDATE,CCALL,ISDATA,XDATA(1,N),ND1,NSTA,
     3            ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
     4            LSTORE,ND9,LITEMS,CORE,ND10,
     5            NBLOCK,NFETCH,
     6            IS0,IS1,IS2,IS4,ND7,
     7            L3264B,L3264W,IER)
C
 85   CONTINUE
C
C        JD( ) IS NOT ACTUALLY USED IN RETVEC.  IT IS USED
C        IN CALL TO CONST, BUT CONST DOES NOT USE IT EITHER.
C
      IF(IER.EQ.0)THEN
C           IT SEEMS THIS WOULD BE AN UNUSUAL CASE WHEN OPFCST
C           IS CALLED AND OPERATIONAL FORECASTS ARE ALREADY
C           PRESENT. PRINT **** DIAG AND RETURN EXISTING DATA
         WRITE(KFILDO,95)(ID(J,1),J=1,4)
 95      FORMAT(/,' ****OPERATIONAL FORECASTS FOR  ',
     1             I9.9,1X,I9.9,1X,I9.9,1X,I10.3,
     2            ' ALREADY AVAILABLE IN OPFCST.',/,
     3            '     NO REPLACEMENT WITH BACKUPS DONE.')
C           EXISTING OPFCSTS ARE RETURNED IN XDATA
         IER=0
         GO TO 300
      ENDIF
C
C        DROP THROUGH HERE MEANS OPEATIONAL FORECASTS ARE NOT ALREADY
C        PRESENT. THEY MUST BE CREATED FROM PRIMARY AND SECONDARY IDS
C
C        FETCH (PRIMARY VALUES). 
C       
      LD(1)=ITABLE(2,JJ)
      LD(2)=ID(2,1)
      LD(3)=ID(3,1)
C
      DO 100 N=1,NCAT
C
      LD(4)=ID(4,N)
C      
      CALL PRSID1(KFILDO,LD,LDPARS)
      CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA,
     1            LD,LDPARS,JD,ITAU,
     2            NDATE,MDATE,CCALL,ISDATA,XDATA(1,N),ND1,NSTA,
     3            ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
     4            LSTORE,ND9,LITEMS,CORE,ND10,
     5            NBLOCK,NFETCH,
     6            IS0,IS1,IS2,IS4,ND7,
     7            L3264B,L3264W,IER)
C
C        JD( ) IS NOT ACTUALLY USED IN RETVEC.  IT IS USED
C        IN CALL TO CONST, BUT CONST DOES NOT USE IT EITHER.
C
 100  CONTINUE
C     
C
      IF(IER.NE.0)THEN
C           PRIMARY FORECASTS ARE NOT PRESENT.
         WRITE(KFILDO,137)(LD(J),J=1,4),MDATE
  137    FORMAT(' ****CANNOT OBTAIN PRI FCST',I9.9,1X,I9.9,1X,I9.9,
     1          1X,I10.3,' IN OPFCST FOR DATE',I11,'.')         
         IER=102
         GO TO 300
      ENDIF
C
C       FETCH (SECONDARY VALUES) INTO YDATA( ).
C
      LD(1)=ITABLE(3,JJ)
C
      DO 140 N=1,NCAT
C
      LD(4)=ID(4,N)
      IF (LD(1)/1000.EQ.208620) LD(4)=500000000
C
      CALL PRSID1(KFILDO,LD,LDPARS)
      CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA,
     1            LD,LDPARS,JD,ITAU,
     2            NDATE,MDATE,CCALL,ISDATA,YDATA(1,N),ND1,NSTA,
     3            ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
     4            LSTORE,ND9,LITEMS,CORE,ND10,
     5            NBLOCK,NFETCH,
     6            IS0,IS1,IS2,IS4,ND7,
     7            L3264B,L3264W,IER)
C
 140  CONTINUE
C
C        JD( ) IS NOT ACTUALLY USED IN RETVEC.  IT IS USED
C        IN CALL TO CONST, BUT CONST DOES NOT USE IT EITHER.
C
      IF(IER.NE.0)THEN
C           BACKUP FORECASTS ARE NOT PRESENT.  
C           NOV 2018:  BACKUP FORECASTS ARE EXPECTED TO BE MISSING
C           FOR VARIOUS POP RECORDS BEYOND 25 HOURS.  IN THIS CASE
C           THERE SHOULD NOT BE AN ERROR RETURN, BECAUSE PRIMARY
C           FORECASTS SHOULD BE AVAILABLE.  NOTE THAT THIS "EXCEPTION"
C           CUES OFF THE VALUE OF JJ (POSITION WITHIN THE ITABLE) SO
C           IF THE POSITIONING CHANGES, MODIFY THE IF STATEMENT 
C           BELOW ACCORDINGLY.
C
        IF ((MOD(LD(3),1000).GT.25).AND.((JJ.GE.5.AND.JJ.LE.7))) THEN
          WRITE(KFILDO,158) (LD(J),J=1,4),MDATE
  158     FORMAT(/,' CANNOT OBTAIN BCK FCST ',4I11.9,' IN OPFCSTID',
     1             ' FOR DATE ',I10,' ... BUT THIS IS EXPECTED AND',
     2             ' PROCESSING WILL CONTINUE, SUPPLY MISSING VALUES.')
          DO K=1,NSTA
            DO N=1,NCAT
              YDATA(K,N)=9999.0
            END DO
          END DO
          IER=0
        ELSE
          WRITE(KFILDO,159)(LD(J),J=1,4),MDATE
  159     FORMAT(' ****CANNOT OBTAIN BCK FCST ',I9.9,1X,I9.9,1X, 
     1           I9.9,1X,I10.3,' IN OPFCST FOR DATE',I11,'.')
          IER=102
          GO TO 300
        END IF
      ENDIF
C     
C        DETERMINING WHETHER THE PRIMARY VALUES ARE MISSING. IF THEY ARE 
C        MISSING, REPLACE THE PRIMARY MISSING VALUES WITH THE SECONDARY VALUES.
C
      DO 180 K=1,NSTA
      DO 179 N=1,NCAT
C       
      IF((NINT(XDATA(K,N)).EQ.9999).OR.(NINT(XDATA(K,N)).EQ.9997))THEN
         IF(NINT(YDATA(K,N)).NE.9999) XDATA(K,N)=YDATA(K,N)
      ENDIF
C
 179  CONTINUE
 180  CONTINUE
C
C       IF 'OPFCSTID' COULD NOT FIND PRIMARY OR SECONDARY DATA RECORDS 
C	ROUTINE WILL RETURN MISSING DATA (9999)
C      
 300  IF(IER.NE.0)THEN
         DO 310 K=1,NSTA
            DO 309 J=1,MAX(1,NCAT)
               XDATA(K,J)=9999.
 309        CONTINUE 
 310     CONTINUE
      ENDIF
C
      RETURN
      END