C$$$  MAIN PROGRAM DOCUMENTATION BLOCK  ***                             
C                                                                       
C MAIN PROGRAM: LMP_LAVTXT_VAL
C   PRGMMR: ERICKSON         ORG: OST22       DATE: 2002-01-11
C                                                                       
C ABSTRACT:  GENERATES THE LMP TEXT BULLETIN "MAV"
C            CONTAINING GFS BASED OBJECTIVE GUIDANCE FOR STATIONS IN 
C            U.S., AK, HAWAII & PUERTO RICO.
C            FORECASTS ARE GIVEN EVERY HOUR FROM 1 TO 25 HOURS.    
C            THIS BULLETIN IS SENT OUT UNDER 10 SEPERATE WMO HEADERS 
C            AND PILS FOR DIFFERENT GROUPS OF STATIONS. 
C                                                                       
C PROGRAM HISTORY LOG:                                                  
C   05-05-11  JRW     - STARTED WITH MDL_GFSMAVTX BULLITINE CODE.  MODIFIED
C                       FOR LAMP PURPOSES.
C   05-11-03  JRW     - MODFIED THE WIND DIRECTION AND SPEED PART, TO FIX
C                       PROBLEM WITH CALM WIND DIRECTION. 
C   05-11-09  JRW     - MODIFIED THE IDS FOR LMP TSTM PRBS AND CATS
C   06-02-09  JRW     - MODIFIED THE IF STATEMENT FOR THE TSTM PRBS AND CATS.
C                       MORE PROJECTIONS WERE ADDED.
C   06-03-14  JRW     - FIXED ERROR IN ADDED UTC CYCLE TO THE FIRST LINE.
C                       THE HIGHEST THE CYCLE COULD BE WAS 18.  IT HAS 
C                       NOW BEEN FIXED TO 23.
C   06-06-01  JRW     - REMOVED DATE CHECK FOR PTYPE ELEMENTS.
C   06-20-01  JRW     - MODIFIED NAME OF PROGRAM TO BE LAVTXT INSTEAD 
C                       OF GFSMAVTX. CLEANED UP DOCBLOCKx
C   11-10-12  WEISS   - CHANGED MAXSTA FROM 3500 TO 5000 TO BE ABLE TO
C                       READ THE INPUT LAMP FORECAST FILE.  CHANGED THE
C                       ID(1) FOR SKY COVER FROM 208351 TO 208381.
C   13-05-10  HUANG   - MODIFIED TO ADD CONVECTION PROBABILITY AND CONVECTION
C                       CATEGORY TEXT BULLETIN.
C   13-05-13  HUANG   - MOVED THE CONVECTION PROB. AND CAT. FORECAST TO BE
C                       AFTER THE TSTM PROB. AND CAT. FORECAST. ALSO RENAMED
C                       TSTM FORECASTS TO BE LIGHTNING FORECASTS. 
C   13-05-15  HUANG   - CHANGED THE LIGHTNING POTENTIAL FORECAST TO BE THE
C                       NEW LIGHTNING POT. FORECAST THAT INCLUDE "NONE" (N),
C                       "LOW" (L), "MEDIUM" (M) AND "HIGH" (H), INSTEAD OF Y/N. 
C   NOV 2016  SCHNAPP - USE MELD C&V FORECASTS (DD=35)
C   MAR 2017  HUANG   - CHANGED THE IDS FOR 2-H LTG/CONV PROB AND POT TO BE 
C                       THE 1-H LTG/CONV PROB AND POT. MODIFIED THE
C                       PROJECTIONS TO BE FROM 1ST TO 25TH. 
C   MAY 2017  GUARRIELLO - CHANGED MAXSTA TO 6000
C   MAY 2018  SINDIC-RANCIC - MODIFIED TO ADD SECOND BULLETIN FOR
C                             PROJECTIONS 26-36
C   JULY 2018  SINDIC-RANCIC - MODIFIED TO ADD FULL BULLETIN FOR
C                              PROJECTIONS 1-38
C   AUG 2018 SINDIC-RANCIC - MODIFIED TO RECOGNISE HANDLE 15 MIN RUNS
C   AUG 2018 SINDIC-RANCIC - MODIFIED TO DISABLE PRINTING MISSING VALUES
C                            FOR ELEMENTS THAT DO NOT EXTENED PAST 25TH 
C                            PROJECTION; MODIFIED TO ENABLE SKIPPING 
C                            THE LINES IN EXTENDED BULLETIN FOR ELEMENTS 
C                            THAT DO NOT HAVE EXTENDED FORECAST
C   SEP 2018 SINDIC-RANCIC - MODIFIED TO ADD DATE LINE AND HOUR
C                            (PROJECTION) LINE
C   OCT 2018 SINDIC-RANCIC - MODIFIED TO ADD PROBABILITY OF PRECIP IN 1H
C                            PERIOD: P01 AND CATEGORICAL PROBABILITY OF 
C                            PRECIPITATION IN 1H PERIOD: PC1; SET UP
C                            TEMPORARI RYREADING OF P01, PC1, P06 AND P12 
C                            FROM FRED'S FILE
C   JUL 2019 HUANG         - CHANGED IDs FOR PC1 AND P06 TO MATCH WITH
C                            Phil'S IDS
C   JAN 2020 HUANG         - CHANGED CLD (SKY COVER) ID FROM BASE TO
C                            MELD.
C   FEB 2020 HUANG         - CHANGED TO BE lavtxt_val TO PRINT CIG AND
C                            VIS IN VALUES FOR AK REMOTE STATIONS.
C
C USAGE:                                                                
C                                                                       
C   SEE BELOW FOR MDL STANDARDS                                         
C                                                                       
C     PROGRAM LAVTXT                                                  
C                                                                       
C        DATA SET USE
C        READ(5...      - STANDARD INPUT /nwprod/parm/lmp_lavtxt.cn
C        WRITE(6...     - STANDARD OUTPUT
C       *FORT.48(FTN48) - MDL MOS 2000 FCST FILE (INPUT)
C       *FORT.27(FTN27) - STATION DICTIONARY (INPUT)
C       *FORT.10(FTN10) - NMC STANDARD DATE FILE (INPUT)
C       *FORT.60(FTN60) - TELETYPE MESSAGE (OUTPUT)
C
C       * CRAY (HOBBS) - ASSIGNMENT FILE NAMES
C                                                                       
C        VARIABLES
C
C        SUBROUTINE RDWMO CALLING ARGUMENTS:
C                 JUNIT=FILE NUMBER(5) USED TO ACCESS MRF STATION
C                       DIRECTORY FILE
C                  LIST=LIST OF NMOSTA CALL LETTERS OF STATIONS,
C                       LEFT JUSTIFIED (8 CHARACTERS)
C                MAXSTA=MAXIMUM NUMBER OF STATIONS (ACTUALLY NEEDS TO
C                       BE # OF STATIONS X 2 FOR READ_MOSDA) NOTE: THIS
C                       ACTUALLY NEEDS TO BE THE NUMBER OF STATIONS IN 
C                       THE DICTIONARY THAT THE CODE READS
C                 NHEAD=NUMBER OF WMO STATION CALL LEADER HEADERS
C                       (EX. MRFFOX42AZ)
C                  NWMO=NUMBER OF STATIONS IN WMO CALL LETTER ARRAY,
C                       WMO(I)
C                   WMO=LIST OF WMO HEADERS(CHARACTER *8)
C
C            SUBROUTINE RDLSTA CALLING ARGUMENTS:
C                      CFMT=CONTAINS FORMAT OF DATA
C                     DTEMP=TEMPORARY ARRAY USED TO READ ONE RECORD
C                DATA(LIST)=LIST OF NMOSTA CALL LETTERS OF STATIONS 
C                    IVALEN=LENGTH OF EACH CHARACTER STRING WHICH
C                           IS READ (8 IN THIS CASE)
C                     JUNIT=FILE NUMBER(5) SEE RDWMO:
C                  LEFT(ND)=SIZE OF ARRRAY NAME
C                        NT=CHARACTER STRINGS READ PER RECORD(9)
C                      NVAL=COUNT OF ELEMENTS IN ARRAY RETURNED
C                      TERM=CHARACTER STRING TO INDICATE THE 
C                           TERMINATOR OF A LIST OF STATION CALL
C                           LETTERS FOR A PARTICULAR WMO HEADER
C
C
C        ADDITIONAL VARIABLES:
C
C**             CBULHD=BULLETIN HEADER  (CHAR*18)
C**                 IC=TIME CYCLE IDENTIFIER (IC=1 00Z, IC=2 12Z)
C**                ICY=CYCLE INDICATOR (1-00, 2-06, 3-12, 4-18)
C**             IDA(3)=ARRAY USED TO HELP CALCULATE CALENDER DAY (CDAY)
C**                INC=TIME INCREMENT
C**                 IS=COUNTER VARIABLE (DEPENDENT ON IC)
C**             IYR(3)=ARRAY USED TO HELP CALCULATE CALENDER DAY (CDAY)
C**              JDATE=DATE CHECK FOR SNOW (CPOS)
C**                JDY=JULIAN DATE USED TO HELP CALCULATE CDAY
C**         KOUNT( , )=INITIALLY SET TO ZERO, INCREASED BY 1            
C**                    WHERE A FORECAST IS ENTERED IN THAT LINE.        
C**                    1ST DIMENSION = LINE                             
C**                    2ND DIMENSION = GREATER THAN OR EQUAL TO NMOSTA
C**             LBULHD=NUMBER OF CHARACTERS IN BULLETIN HEADER
C**               LINE=NUMBER OF LINES REQUIRED PER STATION
C**              MO( )=ARRAY OF MONTH NUMBER(1-12) USED WITH W3SF13 FOR
C**                    CALCULATION OF THE JULIAN DAY.  
C**          MSG(80, )=AREA INTO WHICH TELETYPE MESSAGE IS BUILT        
C**                    LAST DIMENSION=NOLINE SHOULD BE GE LINE*NMOSTA+5
C**               MYGA=LAST TWO DIGITS OF CURRENT YEAR
C**              NBLAK=BLANK CHARACTER
C**              NBSTA=BEGINNING STATION NUMBER (USED TO DELINEATE
C**                    BULLETIN IN WRMSG)
C**              NESTA=ENDING STATION NUMBER (USED TO DELINEATE
C**                    BULLETIN IN WRMSG)
C**              NFILL=CHARACTER USED AS FILL IN THE FOUS14--IS TRANS-
C**                    PARENT TO THE AFOS OR TTY SYSTEM.
C**             NMOSTA=NUMBER OF STATIONS FOR WHICH BULLETIN IS PREPARED
C**                    RETURNED FROM RDLSTA
C**             NOCHAR=1ST DIMENSION OF MSG( , )-MAX NUMBER OF CHARACTER
C**             NOHEAD=NUMBER OF LINES IN THE HEADER, INCLUDING BLANK
C**                    LINES.
C**             NOLINE=2ND DIMENSION OF MSG( , )-MAX NUMBER OF LINES
C**               NOUT=OUTPUT TRANSMISSION FILE UNIT NUMBER (=65)
C**              NTEMP=NUMBER OF STATIONS RUN (USUALLY EQUAL TO NMOSTA)
C**              NUNIT=OUTPUT PRINT (READABLE) FILE UNIT NUMBER (=60)
C**               VBAR=ASCII CHARACTER "BAR" (SEPARATOR LINE)
C**                    NECESSARY FOR TRANSMISSION
C
C                                                                       
C   SUBPROGRAMS CALLED:
C      UNIQUE: RDWMO(CALLS RDLSTA)
C
C     LIBRARY:                                                          
C       W3LIB: W3AG15,W3DOXDAT                     
C       TDLLIB: CHKMOS,GETDATE,CHNGDATE,GTMOS,PUTMOS,PUTCHAR,
C              PRMSG,WRMSG,MISSNG,OPMIOS,RDLSTA,PUTQ
C
C       CHNGDATE: SEE DOCUMENTATION WRITEUPS
C
C       GETDATE,GTMOS AND OPMOS: SEE DOCUMENTATION WRITEUPS
C
C       CHKMOS=CHECKS LDATE(OPERATIONAL DATE) VS
C              IDATE(DATE THE MOS DATA IN THE MOS DATA FILE
C              WERE GENERATED)
C
C      PUTCHAR=SUBROUTINE WHICH COPIES CHARACTER STRINGS FROM
C              STRING TO ANOTHER; AVOIDS HAVEING TO USE DO LOOPS.
C
C       PUTMOS=SUBROUTINE WHICH CONVERTS A NUMBER (INTEGER OR
C              REAL), CONVERTS THE NUMBER TO A CHARACTER STRING
C              WHICH CAN THEN BE COPIED TO THE BULLETIN MESSAGE.
C
C         PUTQ=SUBROUTINE WHICH ATTACHES CONTROL CHARACTERS AT
C              THE END OF EACH RECORD FOR AFOS TRANSMISSION
C              (CALLED BY WRMSG)
C
C       RDLSTA=TO READ CHARACTER DATA WITH A GIVEN FORMAT.
C              ASSUME A MAX RECORD LENGTH OF 80 BYTES.
C
C        PRMSG=PRINTS AN ASCII(SEQUENTIAL FILE) OUTPUT OF MRF
C              STATION BULLETINS
C
C        WRMSG=GENERATES AN ASCII(DIRECT ACCESS "FORMATTED") FILE
C              WITH EBSCDIC CONTROL CHARACTERS (TRANSMISSION 
C              COMPONENTS) OF MRF STATION BULLETINS
C
C                                                                       
C   EXIT STATES:   (STOPS OCCUR IN MAIN UNLESS OTHERWISE STATED)
C     COND =   0 - SUCCESSFUL RUN
C          =  30 - NUMBER OF STATIONS IN LIST ARE EXCEEDED
C          = 100 - PROBLEM READING AVN MOS 2000 FORECAST FILE
C          = 115 - UNABLE TO READ THE STANDARD NMC DATE FILE       
C          = 270 - NO MOS FORECASTS WERE AVAILABLE          
C COMMENTED= 475 - CAN NOT POST MESSAGE WITH W3AG15        
C    OUT                                           
C                                                                       
C REMARKS:                                                              
C     6000 STATIONS MAX                                                 
C                                                                       
C                                                                       
C ATTRIBUTES:                                                           
C   LANGUAGE: XLF90                                                
C   MACHINE:  IBM SP
C
C$$$
      PROGRAM LAVTXT

C NOCHAR increased to 120 to accomodate 38 projections
      PARAMETER(NOCHAR=120,MAXSTA=7000,LINE=28)
CGSR      PARAMETER(NOCHAR=81,MAXSTA=7000,LINE=24)
      PARAMETER(NOHEAD=1,ND7=54)
      PARAMETER(NPRJ=25)

      INTEGER KOUNT(LINE,MAXSTA),IDA(4),NWMO(MAXSTA),IOPT,
     2        KUNIT,JUNIT,IUNIT,NUNIT,NDATE,NSTA,ID(4),NERR,
     3        NMOSTA,LDATE,KUT,IFLAG,IERR,MDG,MHG,MOG,MYG,NHEAD,
     4        DY,INC,JDATE,MYGA,JDAY,IMO(4),MHU,LOCD(4,4),
     5        ND5,ICY,INDEX(MAXSTA,5),IPTST,KPOS,KD(4),IS0(ND7),
     6        IS1(ND7),IS2(ND7),IS4(ND7),
     7        NBMIN,NBMAX,JPRJ,JPRJ06,NNPRJ,IND

      REAL FCST(MAXSTA),FCST1(MAXSTA)

C      CHARACTER*1 MSG(NOCHAR,MAXSTA*LINE+NOHEAD),NBLAK,NFILL,MREC
C Generic vharacther array  
C MSG(NOCHAR,MAXSTA*LINE+NOHEAD)-  up to full bulletin (1-38prj): NOCHAR=120
C Adding specific charachter arrayes for printing specific bulletins 
C MSG1(81,MAXSTA*LINE+NOHEAD)   - regular bulletin (1-25 prj)
C MSG2(48,MAXSTA*LINE+NOHEAD)   - extended bulletin (26-38prj)
C MSG4(48,MAXSTA*LINE+NOHEAD)   - mini run bulletin (1-3prj)

      CHARACTER*1 
     1           MSG(NOCHAR,MAXSTA*LINE+NOHEAD),
     2           MSG1(81,MAXSTA*LINE+NOHEAD),
     2           MSG2(48,MAXSTA*LINE+NOHEAD),
     2           MSG4(48,MAXSTA*LINE+NOHEAD),
     3           NBLAK,NFILL,VBAR
      CHARACTER*1 POPT(4),LC1(0:9),PC0(3),PC1(3),CC1(0:9)
      CHARACTER*2 CLD(6),OBV(6),MVAL
      CHARACTER*4 CMNTH(12)
      CHARACTER*5 CTYPE
      CHARACTER*6 CDESC
      CHARACTER*8 LIST(MAXSTA)
      CHARACTER*8 CCALL(MAXSTA,6)
      CHARACTER*18 CBULHD,WMO(MAXSTA)
      CHARACTER*20 CNAME(MAXSTA)
      CHARACTER*80 BFILE

      DATA KUNIT/12/,JUNIT/5/,IUNIT/10/
CGSR      DATA KUNIT/12/,JUNIT/5/,IUNIT/10/,NUNIT/60/
      DATA NBLAK/' '/,NFILL/'^'/,LBULHD/11/,KFILD/27/,KFILDO/6/
      DATA KFILX/48/,IPTST/0/
      DATA CLD/'CL','FW','SC','BK','OV','XX'/,POPT/'Z','S','R','X'/
      DATA OBV/' N','HZ','BR','FG','BL','XX'/
      DATA PC0/'N','Y','X'/
      DATA PC1/'N','Y','X'/
      DATA LC1/'N','X','X','X','L','X','M','X','H','X'/
      DATA CC1/'N','X','X','X','L','X','M','X','H','X'/
C
      DATA CMNTH/'JAN ','FEB ','MAR ','APR ','MAY ','JUNE','JULY',
     *           'AUG ','SEPT','OCT ','NOV ','DEC '/ 
      DATA LOCD/5,25,49,67,5,19,43,64,5,13,37,61,5,31,55,79/
C
      DATA NEW/0/

C        HOUR PROJECTIONS ARE 1-25 FOR THE FIRST BULETIN AND 26-36 FOR
C        SECOND AND 1-36 FOR THE THIRD                                   

      DATA IOPT/0/,NMOSTA/0/,NDATE/0/,LDATE/0/
      DATA MDATE/0/,JDATE/0/,NHEAD/0/,NESTA/0/

      CALL W3TAGB('LMP_LAVTXT',2006,0011,0066,'OST21')
      ND5=MAXSTA
      VBAR=CHAR(203)

C        INITIALIZE ARRAYS
      DO 102 M=1,MAXSTA
	FCST(M)=0.
        NWMO(M)=0
      DO 102 K=1,LINE
        KOUNT(K,M)=0
  102 CONTINUE

C        READ IN THE CONTROL FILE INFORMATION.(INPUT)
      READ(JUNIT,103) BFILE
 103  FORMAT(A80)
      WRITE(KFILDO,104) BFILE
 104  FORMAT(' ',A80)

C        READ BULLETIN HEADERS AND STATIONS FROM CONTROL FILE           
      CALL RDWMO(JUNIT,NMOSTA,LIST,WMO,NWMO,NHEAD,MAXSTA)
      WRITE(6,108) NMOSTA
  108 FORMAT(1X,'NMOSTA=',I10)
      NOLINE=(NMOSTA*LINE)+NOHEAD 
      WRITE(6,109)NHEAD 
  109 FORMAT(1X,'NHEAD=',I10) 
      KUT=0 
C
C        CALL RDLNK TO RETURN THE NEWEST CALL LETTER LINKS FOR THE 
C        STATIONS IN LIST.  THE STATION LIST WILL BE RETAINED IN 
C        IN CCALL(J,1) 
C 
      CALL RDLNK(KFILD,KFILDO,NEW,LIST,CCALL,NMOSTA,MAXSTA)  

C     READ IN VALUE FOR ENVIRONMENTAL VARIABLE MIN TO DETERMINE
C     HOW MANY BULLETINS NEED TO BE PRINTED

CCC      LVAL = GETENVQQ('MIN', MVAL)
      call getenv( 'MIN', MVAL )
      write(*,*) "'", MVAL, "'"

C    FOR 00, 15 AND 45 MIN RUN THERE WILL BE ONE BULLETIN WITH 3
C    PROJECTIONS; FOR 30 MIN RUN THERE WILL BE 3 BULLETINS: 1-25
C    PROJECTIONS; 26-38 PROJECTIONS AND 1-38 PROJECTIONS; 

      IF (MVAL == '30') THEN
      NBMIN=1
      NBMAX=3
      ELSE
      NBMIN=4
      NBMAX=4
      ENDIF

C     LOOP THROUGH BULLETINS

      DO 415 NB=NBMIN,NBMAX

      
      SELECT CASE (NB) 
C  REGULAR BULLETIN
             CASE (1)   
                     JPRJ=1 
                     JPRJ06=6 
                     NNPRJ=25
                     NUNIT=60
C EXTENDED BULLETIN
             CASE (2)   
                     JPRJ=26 
                     JPRJ06=26 
                     NNPRJ=38
                     NUNIT=61
C FULL BULLETIN
             CASE (3)
                     JPRJ=1
                     JPRJ06=6 
                     NNPRJ=38
                     NUNIT=62
C MINI BULLETIN
             CASE (4)
                     JPRJ=1
                     NNPRJ=3
                     NUNIT=60
      END SELECT

C
C        FILL THE MESSAGE ARRAY WITH BLANKS EXCEPT FOR THE 1ST CHARACTER 
C
      DO 110 M=1,NOLINE 
      DO 110 K=1,NOCHAR 
          MSG(K,M)=NBLAK 
          IF(K.EQ.1)MSG(K,M)=NFILL 
  110 CONTINUE 
C
C        READ NMC STANDARD DATE FILE 
C        PUT DATE IN MDL FORMAT 
C
       CALL GET_NCEPDATE(IUNIT,MYG,MOG,MDG,MHG,LDATE,IERR) 
C
      IF(IERR.NE.0) THEN 
         CALL W3TAGE('LMP_LAVTXT') 
         STOP 115 
      ENDIF 
C
C        FIND VALID DATES FOR HEADINGS.  
C        FOR 3 CALENDER DAYS
C        THIS WILL NEED ADJUSTING FOR 4 CYCLES
C
      ICY=(MHG/6) + 1
C 
      MDATE=LDATE 
C
C        FIRST GET MONTH AND DAY FOR SECOND LINE
C        CHANGED THIS LOOP TO 4 ITERATIONS TO GET
C        72 HOUR DATE FOR 1200 UTC
      DO 115 K=1,4
        IF (K.NE.1) CALL CHNGDATE(-MDATE,24,MDATE)
C        IF ((K.NE.1).OR.(ICY.EQ.4)) CALL CHNGDATE(-MDATE,24,MDATE)
        IMO(K)=MOD((MDATE/10000),100)
        IDA(K)=MOD((MDATE/100),100)
 115  CONTINUE

C        CONVERT 1995 TO 95 (FOR DISPLAY PURPOSES) 
      MYGA=MOD(MYG,100) 
      MYGC=MYG/100 
C 
C***** 
C*****   START CONSTRUCTION OF THE BULLETIN 
C***** 
C        PLACE HEADER INFO FOR EACH STATION 
C 
      DO 140 K=1,NMOSTA 
C 
C=======================================================================
C        BUILD 1ST LINE 
C=======================================================================
      CALL PUTCHAR('$',MSG(1,(K-1)*LINE+2),1) 
      CALL PUTCHAR(CCALL(K,1),MSG(2,(K-1)*LINE+2),4) 
      CALL PUTCHAR('GFS LAMP GUIDANCE',MSG(9,(K-1)*LINE+2),17) 
      CALL PUTCHAR('/  /',MSG(30,(K-1)*LINE+2),4) 
      CALL PUTMOS('MOG',FLOAT(MOG),0.,1.,1,12,MSG(28,(K-1)*LINE+2), 
     *       2,0,'99',KX) 
      CALL PUTMOS('MDG',FLOAT(MDG),0.,1.,1,31,MSG(31,(K-1)*LINE+2), 
     *       2,2,'99',KX) 
      CALL PUTMOS('MYG',FLOAT(MYGC),0.,1.,19,99,MSG(34,(K-1)*LINE+2),
     *       2,2,'99',KX)
      CALL PUTMOS('MYG',FLOAT(MYGA),0.,1.,0,99,MSG(36,(K-1)*LINE+2),
     *       2,2,'99',KX)
      
      IF (MVAL == '00') THEN
      CALL PUTCHAR('00 UTC',MSG(42,(K-1)*LINE+2),6)
      ENDIF

      IF (MVAL == '15') THEN
      CALL PUTCHAR('15 UTC',MSG(42,(K-1)*LINE+2),6)
      ENDIF

      IF (MVAL == '30') THEN
      CALL PUTCHAR('30 UTC',MSG(42,(K-1)*LINE+2),6)
      ENDIF

      IF (MVAL == '45') THEN
      CALL PUTCHAR('45 UTC',MSG(42,(K-1)*LINE+2),6)
      ENDIF

      CALL PUTMOS('MHG',FLOAT(MHG),0.,1.,0,23,MSG(40,(K-1)*LINE+2),
     *       2,2,'99',KX)
      KOUNT(1,K)=1
C=======================================================================
C        PLACE DATE HEADER (SECOND LINE)
C=======================================================================
C 
        IF(NB.EQ.2) MHU=MOD((MHG+26),24)
        IF(NB.EQ.3) MHU=MHG+1

C       CONSTRUCT DATE LINE FOR EXTENDED BULLETIN

        IF(NB.EQ.2) THEN
       CALL PUTCHAR('DT ',MSG(2,(K-1)*LINE+3),3)

C     CYCLE THROUGH 2 DAYS AND PUT DATE WHERE APROPRIATE
      DO 119 J=1,2
        IF(J.EQ.1) IPOS=5
        IF(J.GT.1) IPOS=5+((J-1)*24-MHU)*3+2

        IF(IPOS.LE.44) THEN

        IF(J.NE.1.AND.MHG.EQ.21) THEN
        CALL PUTCHAR('/',MSG(IPOS,(K-1)*LINE+3),1)
        IF(IPOS.LE.37) THEN
        CALL PUTCHAR(CMNTH(IMO(J+1)),MSG(IPOS+1,(K-1)*LINE+3),4)
        CALL PUTMOS('DAY',FLOAT(IDA(J+1)),0.,1.,0,31,MSG(IPOS+6,
     2       (K-1)*LINE+3),2,0,'99',KX)
        ENDIF
        ENDIF
        IF(J.EQ.1.AND.MHG.GE.22) THEN
        CALL PUTCHAR('/',MSG(IPOS,(K-1)*LINE+3),1)
        IF(IPOS.LE.37) THEN
        CALL PUTCHAR(CMNTH(IMO(J+2)),MSG(IPOS+1,(K-1)*LINE+3),4)
        CALL PUTMOS('DAY',FLOAT(IDA(J+2)),0.,1.,0,31,MSG(IPOS+6,
     2       (K-1)*LINE+3),2,0,'99',KX)
        ENDIF 
        ENDIF 
        IF(MHG.LT.21) THEN
        CALL PUTCHAR('/',MSG(IPOS,(K-1)*LINE+3),1)
        IF(IPOS.LE.37) THEN
        CALL PUTCHAR(CMNTH(IMO(J+1)),MSG(IPOS+1,(K-1)*LINE+3),4)
        CALL PUTMOS('DAY',FLOAT(IDA(J+1)),0.,1.,0,31,MSG(IPOS+6,
     2       (K-1)*LINE+3),2,0,'99',KX)
        ENDIF
        ENDIF

        ENDIF

 119  CONTINUE

      KOUNT(2,K)=1

        ENDIF

C  CONSTRUCTING DATE LINE FOR FULL BULLETIN

        IF(NB.EQ.3)THEN
       CALL PUTCHAR('DT ',MSG(2,(K-1)*LINE+3),3)

C     CYCLE THROUGH 3 DAYS AND PUT DATE WHERE APROPRIATE
      DO 118 J=1,3
        IF(J.EQ.1) IPOS=5
        IF(J.GT.1) IPOS=5+((J-1)*24-MHU)*3+2

        IF(IPOS.LE.119)THEN

        IF(MHG.GE.22) THEN 
        IF(J.NE.1) THEN 
        CALL PUTCHAR('/',MSG(IPOS,(K-1)*LINE+3),1)
        IF(IPOS.LE.112)THEN
        CALL PUTCHAR(CMNTH(IMO(J)),MSG(IPOS+1,(K-1)*LINE+3),4)
        CALL PUTMOS('DAY',FLOAT(IDA(J)),0.,1.,0,31,MSG(IPOS+6,
     2       (K-1)*LINE+3),2,0,'99',KX)
        ENDIF
        ENDIF
        ELSE
        IF(MHU.LT.1) IPOS=5
        CALL PUTCHAR('/',MSG(IPOS,(K-1)*LINE+3),1)
        IF(IPOS.LE.112)THEN
        CALL PUTCHAR(CMNTH(IMO(J)),MSG(IPOS+1,(K-1)*LINE+3),4)
        CALL PUTMOS('DAY',FLOAT(IDA(J)),0.,1.,0,31,MSG(IPOS+6,
     2       (K-1)*LINE+3),2,0,'99',KX)
        ENDIF
        ENDIF
        
        ENDIF

 118  CONTINUE

      KOUNT(2,K)=1
        
        ENDIF
C  FOR NB=1 and NB=4 DO NOT PRINT THIS LINE
       IF(NB.EQ.1.OR.NB.EQ.4) KOUNT(2,K)=0
C 
C=======================================================================
C        PLACE HOUR (PROJ) HEADERS (THIRD LINE)
C=======================================================================
C
      IF(NB.EQ.2.OR.NB.EQ.3) THEN
      CALL PUTCHAR('HR ',MSG(2,(K-1)*LINE+4),3)
C      IHR=MHG+3
      IPOS=4
C      DO 136 J=1,21
      DO 136 IPRJ=JPRJ,NNPRJ
C        IHR=IHR+3
        IPOS=IPOS+3
C        THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6
C        IF(J.GE.20) IHR=IHR+3
C        IF(IHR.EQ.24) IHR=0
        CALL PUTMOS('PROJ',FLOAT(IPRJ),0.,1.,0,38,MSG(IPOS,
     *  (K-1)*LINE+4),2,2,'99',KX)
 136  CONTINUE   
      KOUNT(3,K)=1
       ENDIF
C  FOR NB=1 and NB=4 DO NOT PRINT THIS LINE
       IF(NB.EQ.1.OR.NB.EQ.4) KOUNT(3,K)=0
C
C===================================================================
C        PLACE HOUR UTC HEADERS (FOURTH LINE)
C=======================================================================
C  

      CALL PUTCHAR('UTC',MSG(2,(K-1)*LINE+5),3)
      IPOS=4
CGSR      DO 125 IPRJ=1,NPRJ 
      DO 125 IPRJ=JPRJ,NNPRJ 
        IHR=IPRJ+MHG
        IF(IHR.GE.24.AND.IHR.LT.48)IHR=IHR-24
        IF(IHR.EQ.48)IHR=IHR-48
        IF(IHR.GE.48.AND.IHR.LT.72)IHR=IHR-48
        IPOS=IPOS+3
        CALL PUTMOS('HOUR',FLOAT(IHR),0.,1.,0,24,MSG(IPOS,
     1              (K-1)*LINE+5),2,2,'99',KX)
 125  CONTINUE   
      KOUNT(4,K)=1
C
C=======================================================================
C        PLACE FORECAST ELEMENT NAMES                                   
C        (LINES 5 TO LINE)
C=======================================================================
C
        CALL PUTCHAR('TMP',MSG(2,(K-1)*LINE+6),3)
        CALL PUTCHAR('DPT',MSG(2,(K-1)*LINE+7),3)
        CALL PUTCHAR('WDR',MSG(2,(K-1)*LINE+8),3)
        CALL PUTCHAR('WSP',MSG(2,(K-1)*LINE+9),3)
        CALL PUTCHAR('WGS',MSG(2,(K-1)*LINE+10),3)
        CALL PUTCHAR('PPO',MSG(2,(K-1)*LINE+11),3)
        CALL PUTCHAR('PCO',MSG(2,(K-1)*LINE+12),3)
        CALL PUTCHAR('P01',MSG(2,(K-1)*LINE+13),3)
        CALL PUTCHAR('PC1',MSG(2,(K-1)*LINE+14),3)
        CALL PUTCHAR('P06',MSG(2,(K-1)*LINE+15),3)
        CALL PUTCHAR('LP1',MSG(2,(K-1)*LINE+16),3)
        CALL PUTCHAR('LC1',MSG(2,(K-1)*LINE+17),3)
C
        CALL PUTCHAR('CP1',MSG(2,(K-1)*LINE+18),3)
        CALL PUTCHAR('CC1',MSG(2,(K-1)*LINE+19),3)
C
        CALL PUTCHAR('POZ',MSG(2,(K-1)*LINE+20),3)
        CALL PUTCHAR('POS',MSG(2,(K-1)*LINE+21),3)
        CALL PUTCHAR('TYP',MSG(2,(K-1)*LINE+22),3)
        CALL PUTCHAR('CLD',MSG(2,(K-1)*LINE+23),3)
        CALL PUTCHAR('CIG',MSG(2,(K-1)*LINE+24),3)
        CALL PUTCHAR('CCG',MSG(2,(K-1)*LINE+25),3)
        CALL PUTCHAR('VIS',MSG(2,(K-1)*LINE+26),3)
        CALL PUTCHAR('CVS',MSG(2,(K-1)*LINE+27),3)
        CALL PUTCHAR('OBV',MSG(2,(K-1)*LINE+28),3)
        KOUNT(LINE,K)=-1
C        ABOVE STATEMENT PROVIDES FOR BLANK LINE.                       
 140  CONTINUE
C
C      CALL PRMSG(MSG,NOCHAR,NOLINE,KOUNT,LINE,NMOSTA,NUNIT,NOHEAD)
C
C     FOR THE EXTENDED BULLETIN, NB=2, ONLY PRINT P01, PC1, P06, CIG, 
C     VIS AND OBV. 
C
C        PLACE TEMP FORECASTS
C
      ID(1)=202020005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=3
CGSR      DO 180 IPRJ=1,NPRJ,1
      DO 180 IPRJ=JPRJ,NNPRJ,1
        ID(3)=IPRJ
        IPOS=IPOS+INC
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 170 J=1,NMOSTA
           CALL PUTMOS(LIST(J),FCST(J),0.,1.,-99,999,MSG(IPOS,
     1                (J-1)*LINE+6),3,0,'999',KOUNT(5,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 PRINT AS MISSING 
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(5,J)=0
 170    CONTINUE
 180  CONTINUE   
C
C        PLACE DEW POINT FORECASTS
C
      ID(1)=203020005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=3
CGSR      DO 200 IPRJ=1,NPRJ
      DO 200 IPRJ=JPRJ,NNPRJ
        ID(3)=IPRJ
        IPOS=IPOS+INC
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 190 J=1,NMOSTA
          CALL PUTMOS(LIST(J),FCST(J),0.,1.,-99,999,MSG(IPOS,
     1               (J-1)*LINE+7),3,0,'999',KOUNT(6,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(6,J)=0
 190    CONTINUE
 200  CONTINUE      
C
C        PLACE WIND DIRECTION FORECASTS
C
      ID(1)=204225005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=4
CGSR      DO 220 IPRJ=1,NPRJ
      DO 220 IPRJ=JPRJ,NNPRJ
        ID(3)=IPRJ
        IPOS=IPOS+INC
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 210 J=1,NMOSTA
          IF(FCST(J).LT.9999.) THEN
C
C        ROUND THE WIND DIRECTION TO THE NEAREST 10 DEGREES.  IF
C        THE WIND DIRECTION IS BETWEEN 0 AND 5 KNOTS, IT WILL BE
C        ROUNDED TO 0 DEGREES, WHICH IS CALM.  CHANGE ALL CASES
C        WHERE THE VALUE IS 0 OR WOULD ROUND TO 0 TO 36 (360) DEGREES
C
            X=IFIX(FCST(J)/10.+.5) 
            IF(X.LT.0.5) X=36.
          ELSE
            X=9999.
          ENDIF
          CALL PUTMOS(LIST(J),X,0.,1.,0,36,MSG(IPOS,
     1               (J-1)*LINE+8),2,2,'99',KOUNT(7,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(7,J)=0
 210    CONTINUE
 220  CONTINUE      
C
C        PLACE WIND SPEED FORECASTS
C
      ID(1)=204325005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=4
CGSR      DO 240 IPRJ=1,NPRJ
      DO 240 IPRJ=JPRJ,NNPRJ
        ID(3)=IPRJ
        IPOS=IPOS+INC
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 230 J=1,NMOSTA
C
C        SET DIRECTION TO 00 IF SPEED IS CALM.  THIS IS NECESSARY
C        BECAUSE IN THE WIND DIRECTION SECTION, WE CHANGED ALL THE
C        0'S TO 36'S.  NOW WE HAVE TO CHANGE THE LEGITIMATE 0'S (CALM)
C        BACK TO 0'S.
C 
          IF(FCST(J).LT.0.5) THEN
            CALL PUTCHAR('00',MSG(IPOS,(J-1)*LINE+8),2)
            KOUNT(7,J)=1
          ENDIF
          CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,98,MSG(IPOS,
     1                (J-1)*LINE+9),2,2,'99',KOUNT(8,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) THEN 
        KOUNT(7,J)=0
        KOUNT(8,J)=0
        ENDIF

 230    CONTINUE
 240  CONTINUE      
C
C        PLACE MAX WIND GUST SPEED FORECASTS
C
      ID(1)=204355005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=3
CGSR      DO 260 IPRJ=1,NPRJ
      DO 260 IPRJ=JPRJ,NNPRJ
        ID(3)=IPRJ
        IPOS=IPOS+INC
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 250 J=1,NMOSTA
C 
C         IF THERE IS NO GUST SET GUST TO SPACE
C
          IF(FCST(J).LT.0.5) THEN
            CALL PUTCHAR(' NG',MSG(IPOS,(J-1)*LINE+10),3)
            KOUNT(9,J)=1
          ELSE 
            CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,98,MSG(IPOS,
     1                 (J-1)*LINE+10),3,0,'999',KOUNT(9,J))
          ENDIF
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(9,J)=0
 250    CONTINUE
 260  CONTINUE      
C  
C        PLACE PPO FORECASTS
C
      ID(1)=208620105
      ID(2)=0
      ID(3)=0
      ID(4)=500000000
      INC=3
      IPOS=3
CGSR      DO 270 IPRJ=1,NPRJ
      DO 270 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 265 J=1,NMOSTA
          CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS,
     1                (J-1)*LINE+11),3,0,'999',KOUNT(10,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(10,J)=0
 265    CONTINUE
 270  CONTINUE      
C  
C        PLACE PCO FORECASTS
C
      ID(1)=208621005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=5
CGSR      DO 274 IPRJ=1,NPRJ
      DO 274 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 273 J=1,NMOSTA
          IF(FCST(J).LT.9999.) THEN
            KOUNT(11,J)=1
          ELSE
            FCST(J)=3.
          ENDIF
          CALL PUTCHAR(PC0(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+12),1)
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(11,J)=0
 273    CONTINUE
 274  CONTINUE      
C -------- beginning of adding 2 new elements
C  
C        PLACE P01 FORECASTS
C
COLD      ID(1)=208620105
      ID(1)=203610195
      ID(2)=0
      ID(3)=0
      ID(4)=0950052000
      INC=3
      IPOS=3
CGSR      DO 270 IPRJ=1,NPRJ
      DO 277 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 276 J=1,NMOSTA
          CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS,
     1                (J-1)*LINE+13),3,0,'999',KOUNT(12,J))
 276    CONTINUE
 277  CONTINUE      
C  
C        PLACE PC1 FORECASTS
C
COLD      ID(1)=208621005
C      ID(1)=203621035 ! this is Fred's ID
      ID(1)=203621095 ! this is Phil's ID
      ID(2)=0
      ID(3)=0
COLD      ID(4)=0
      ID(4)=0000000400
      INC=3
      IPOS=5
CGSR      DO 274 IPRJ=1,NPRJ
      DO 279 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 278 J=1,NMOSTA
C FCST(J) FOR PC1 takes valuse 0, 1 and 9999.  Those values need to
C be converted into index values (IND) of 1, 2 and 3 so that bulleting
C would print charachter values of N, Y and X.
          IF(FCST(J).LT.9999.) THEN
            KOUNT(13,J)=1
          IF(FCST(J).eq.0) IND=1 
          IF(FCST(J).eq.1) IND=2 
          ELSE
            IND=3.
          ENDIF
          CALL PUTCHAR(PC1(IND),MSG(IPOS,(J-1)*LINE+14),1)
 278    CONTINUE
 279  CONTINUE      
C -------- end of adding 2 new elements
C
C        PLACE P06 FORECASTS
C Changed ID for new PO6
C      ID(1)=203220105 - OLD PO6 ID 
C     UPDATED 11/20/18 TO THE NEW PO6 UP TO 38HR
C      ID(1)=203238135 ! this is Fred's ID
      ID(1)=203230195 ! this is Phil's ID
      ID(2)=0
      ID(3)=0
      ID(4)=0950052000
      INC=3
      IF(NB.EQ.2) IPOS=3
      IF(NB.NE.2) IPOS=18
CGSR      DO 280 IPRJ=6,NPRJ
      DO 280 IPRJ=JPRJ06,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
C        ICHCK=MOD((MHG+IPRJ),6)
        IHR=IPRJ+MHG
        ICHCK=MOD(IHR,6)
        IF(ICHCK.NE.0)GOTO 280
C        IF(ID(3).LT.6)GOT0 280
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 275 J=1,NMOSTA
          CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS,
     1                (J-1)*LINE+15),3,0,'999',KOUNT(14,J))
C ENSURE P06 LINE IS NOT PRINTED IF ALL ARE MISSING
        IF(FCST(J).GE.9999) THEN
        KOUNT(14,J)=0
        ENDIF

 275    CONTINUE
 280  CONTINUE
C
C        PLACE TP2 FORECASTS (CH: RENAMED TO LP2)
C
C      ID(1)=207510105 ! OLD TSTM PROB - FRED "RECYCLED" TO BE 2-H LTGPROB
C        UPDATED MAR 2017 TO BE 1-H LTG PROB (RENAMED TO BE LP1)
C
      ID(1)=207614105
      ID(2)=0
      ID(3)=0
      ID(4)=500000000
      INC=3
      IPOS=3
CGSR      DO 300 IPRJ=1,NPRJ
      DO 300 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
C        ICYCHCK=MOD(MHG,2)
C        IPRJCHCK=MOD(IPRJ,2)
C        IF(ICYCHCK.NE.0.AND.IPRJCHCK.EQ.0.AND.IPRJ.GT.7)GOTO 300
C        IF(ICYCHCK.EQ.0.AND.IPRJCHCK.NE.0.AND.IPRJ.GT.8)GOTO 300
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 295 J=1,NMOSTA
C          CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS,
          CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,100,MSG(IPOS,
     1                (J-1)*LINE+16),3,1,'999',KOUNT(15,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(15,J)=0
 295    CONTINUE
 300  CONTINUE
C
C        PLACE TC2 FORECASTS (CH: RENAMED TO LC2)
C
C      ID(1)=207501005 ! OLD TSTM POTENTIAL ID
C      ID(1)=207511005  ! OLD 2-H LTG POT ID
C        UPDATED MAR 2017 TO BE LC1 (1-H LTG POT CAT)
C
      ID(1)=207611005
      ID(2)=0
      ID(3)=0
      ID(4)=0000000000
      INC=3
C      IPOS=11
      IPOS=5
CGSR      DO 304 IPRJ=1,NPRJ
      DO 304 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
C        ICYCHCK=MOD(MHG,2)
C        IPRJCHCK=MOD(IPRJ,2)
C        IF(ICYCHCK.NE.0.AND.IPRJCHCK.EQ.0.AND.IPRJ.GT.7)GOTO 304
C        IF(ICYCHCK.EQ.0.AND.IPRJCHCK.NE.0.AND.IPRJ.GT.8)GOTO 304
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 302 J=1,NMOSTA
          IF(FCST(J).LT.9999.) THEN
            KOUNT(16,J)=1
          ELSE
            FCST(J)=3.
          ENDIF
          CALL PUTCHAR(LC1(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+17),1)
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(16,J)=0
 302    CONTINUE
 304  CONTINUE
C
C        PLACE CP2 FORECASTS
C
C      ID(1)=207564105 - OLD 2-H CONVECTION PROB
C        UPDATED MAR 2017 FOR 1-H CONV PROB (CP1)
C
      ID(1)=207664105 
      ID(2)=0
      ID(3)=0
      ID(4)=500000000
      INC=3
      IPOS=3
CGSR      DO 310 IPRJ=1,NPRJ
      DO 310 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
C        ICYCHCK=MOD(MHG,2)
C        IPRJCHCK=MOD(IPRJ,2)
C        IF(ICYCHCK.NE.0.AND.IPRJCHCK.EQ.0.AND.IPRJ.GT.7)GOTO 310
C        IF(ICYCHCK.EQ.0.AND.IPRJCHCK.NE.0.AND.IPRJ.GT.8)GOTO 310
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 305 J=1,NMOSTA
C          CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS,
          CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,100,MSG(IPOS,
     1                (J-1)*LINE+18),3,1,'999',KOUNT(17,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(17,J)=0
 305    CONTINUE
 310  CONTINUE
C
C        PLACE CC2 FORECASTS
C
C      ID(1)=207561005 - OLD 2-H CONV POT CAT
C        UPDATED MAR 2017 FOR 1-H CONV POT (CC1)
C
      ID(1)=207661005
      ID(2)=0
      ID(3)=0
      ID(4)=0000000000
      INC=3
      IPOS=5
CGSR      DO 320 IPRJ=1,NPRJ
      DO 320 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
C        ICYCHCK=MOD(MHG,2)
C        IPRJCHCK=MOD(IPRJ,2)
C        IF(ICYCHCK.NE.0.AND.IPRJCHCK.EQ.0.AND.IPRJ.GT.7)GOTO 320
C        IF(ICYCHCK.EQ.0.AND.IPRJCHCK.NE.0.AND.IPRJ.GT.8)GOTO 320
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 315 J=1,NMOSTA
          IF(FCST(J).LT.9999.) THEN
            KOUNT(18,J)=1
          ELSE
            FCST(J)=9.
          ENDIF
          CALL PUTCHAR(CC1(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+19),1)
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(18,J)=0
 315    CONTINUE
 320  CONTINUE
C
C        PLACE POZ FORECASTS
C
      ID(1)=208545305
      ID(2)=0
      ID(3)=0
      ID(4)=0350001000
      INC=3
      IPOS=3
CGSR      DO 330 IPRJ=1,NPRJ
      DO 330 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 325 J=1,NMOSTA
          CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS,
     1                (J-1)*LINE+20),3,0,'999',KOUNT(19,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(19,J)=0
 325    CONTINUE
 330  CONTINUE
C
C        PLACE POS FORECASTS
C
      ID(1)=208545305
      ID(2)=0
      ID(3)=0
      ID(4)=0450001000
      INC=3
      IPOS=3
CGSR      DO 340 IPRJ=1,NPRJ
      DO 340 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 335 J=1,NMOSTA
          CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS,
     1                (J-1)*LINE+21),3,0,'999',KOUNT(20,J))
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(20,J)=0
 335    CONTINUE
 340  CONTINUE
C
C        PLACE PTYPE FORECASTS
C
      ID(1)=208546005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=5
CGSR      DO 350 IPRJ=1,NPRJ
      DO 350 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 345 J=1,NMOSTA
          IF(FCST(J).LT.9999.) THEN
            KOUNT(21,J)=1
          ELSE
            FCST(J)=4.
          ENDIF
          CALL PUTCHAR(POPT(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+22),1)
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(21,J)=0
 345    CONTINUE
 350  CONTINUE
C
C        PLACE CLD FORECASTS
C
C      ID(1)=208381005 # this is the base LMP ID
      ID(1)=208381035  
C   The above is the meld ID   
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=4
CGSR      DO 360 IPRJ=1,NPRJ
      DO 360 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 355 J=1,NMOSTA
          IF(FCST(J).LT.9999.) THEN
            KOUNT(22,J)=1
          ELSE
            FCST(J)=6.
          ENDIF
          CALL PUTCHAR(CLD(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+23),2)
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2) KOUNT(22,J)=0
 355    CONTINUE
 360  CONTINUE

C
C        PLACE CEILING (CIG) FORECASTS
C
      ID(1)=228080035
      ID(2)=0
      ID(3)=0
      ID(4)=0000000400
      INC=3
CCH      IPOS=5 # works with "1,1" and '9'
C      IPOS=3 # this works with the "3,0" and '999'
      IPOS=3
CGSR      DO 370 IPRJ=1,NPRJ
      DO 370 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 365 J=1,NMOSTA
C          CALL PUTMOS(LIST(J),FCST(J),0.,1.,1,8,MSG(IPOS,
          CALL PUTMOS(LIST(J),FCST(J),0.,1.,1,130,MSG(IPOS,
C     1                (J-1)*LINE+24),1,1,'9',KOUNT(23,J))
C          BELOW FOR TESING AK
     1                (J-1)*LINE+24),3,0,'999',KOUNT(23,J))
C     1                (J-1)*LINE+24),2,1,'99',KOUNT(23,J))
 365    CONTINUE
 370  CONTINUE
C
C        PLACE CONDITIONAL CEILING (CCG) FORECASTS
C
      ID(1)=208056005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
CCH      IPOS=5 # this works with the "1,1" and '9'
      IPOS=4
CGSR      DO 373 IPRJ=1,NPRJ
      DO 373 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 371 J=1,NMOSTA
C  WORK AROUND TO CHANGE THE MISSING FROM 9 TO 99 
          CALL PUTMOS(LIST(J),FCST(J),0.,1.,1,8,MSG(IPOS,
C     1                (J-1)*LINE+25),1,1,'9',KOUNT(24,J))
     1                (J-1)*LINE+25),2,1,'99',KOUNT(24,J))
C          IF(IPRJ.GT.25)  
C     1    CALL PUTCHAR('99',MSG(IPOS-1,(J-1)*LINE+25),2)
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2.OR.NB.EQ.4) KOUNT(24,J)=0
 371    CONTINUE
 373  CONTINUE
C
C        PLACE VISIBILITY (VIS) FORECASTS
C
      ID(1)=228160035
      ID(2)=0
      ID(3)=0
      ID(4)=0000000400
      INC=3
CCH      IPOS=5 # this works with the "1,1" and '9'
C      IPOS=3 # this works with the "3,0" and '999'
      IPOS=3
CGSR      DO 380 IPRJ=1,NPRJ
      DO 380 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 375 J=1,NMOSTA
C          CALL PUTMOS(LIST(J),FCST(J),0.,1.,1,7,MSG(IPOS,
          CALL PUTMOS(LIST(J),FCST(J),0.,10.,1,180,MSG(IPOS,
C     1                (J-1)*LINE+26),1,1,'9',KOUNT(25,J))
C          BELOW FOR TESTING AK
     1                (J-1)*LINE+26),3,0,'999',KOUNT(25,J))
C     1                (J-1)*LINE+26),2,1,'99',KOUNT(25,J))
 375    CONTINUE
 380  CONTINUE
C
C        PLACE CONDITIONAL VISIBILITY (CVS) FORECASTS
C
      ID(1)=208156005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
CCH      IPOS=5 # this works with the "1,1" and '9'
      IPOS=4
CGSR      DO 390 IPRJ=1,NPRJ
      DO 390 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 385 J=1,NMOSTA
C  WORK AROUND TO CHANGE THE MISSING FROM 9 TO 99 
          CALL PUTMOS(LIST(J),FCST(J),0.,1.,1,7,MSG(IPOS,
C     1                (J-1)*LINE+27),1,1,'9',KOUNT(26,J))
     1                (J-1)*LINE+27),2,1,'99',KOUNT(26,J))
CCH             IF(IPRJ.GT.25) 
CCH     1       CALL PUTCHAR('99',MSG(IPOS-1,(J-1)*LINE+27),2)
C
C  FOR EXTENDED BULLETIN PROJ: 26 -38 DO NOT PRINT AS MISSING
C  ONLY P01, PC1, P06, CIG, VIS AND OBV ARE AVAILABLE TO 38 
C  PROJECTION
        IF(NB.EQ.2.OR.NB.EQ.4) KOUNT(26,J)=0
 385    CONTINUE
 390  CONTINUE
C
C        PLACE OBSTRUCTION TO VISION (OBV) FORECASTS
C
      ID(1)=208291005
      ID(2)=0
      ID(3)=0
      ID(4)=0
      INC=3
      IPOS=4
CGSR      DO 400 IPRJ=1,NPRJ
      DO 400 IPRJ=JPRJ,NNPRJ
        IPOS=IPOS+INC
        ID(3)=IPRJ
        CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL,
     1                  NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4,
     2                  INDEX,IER)
        IF(IER.LT.2) KUT=KUT+1
        DO 395 J=1,NMOSTA
          IF(FCST(J).LT.9999.) THEN
            KOUNT(27,J)=1
          ELSE
            FCST(J)=6.
          ENDIF
          CALL PUTCHAR(OBV(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+28),2)
 395    CONTINUE
 400  CONTINUE
C
      IF (KUT.LE.0) THEN
        WRITE(6,410)
 410    FORMAT(//'NO GFS MOS FORECASTS FOUND.')
      CALL W3TAGE('LMP_LAVTXT')
        STOP 70
      ENDIF
C
C        PRINT MESSAGE                                                  
C
C      CALL PRMSG(MSG,NOCHAR,NOLINE,KOUNT,LINE,NMOSTA,NUNIT,NOHEAD)

C Full bulletin does not need remapping
      IF(NB.EQ.3) THEN 
      CALL PRMSG(MSG,NOCHAR,NOLINE,KOUNT,LINE,NMOSTA,NUNIT,NOHEAD)
      ENDIF

C Remapping regular bulletin
      IF(NB.EQ.1) THEN
      DO 510 M=1,NOLINE 
      DO 510 K=1,81 
          MSG1(K,M)=MSG(K,M)
  510 CONTINUE 
      CALL PRMSG(MSG1,81,NOLINE,KOUNT,LINE,NMOSTA,NUNIT,NOHEAD)
      ENDIF
C
C Remapping extended bulletin
      IF(NB.EQ.2) THEN
      DO 511 M=1,NOLINE 
      DO 511 K=1,48 
          MSG2(K,M)=MSG(K,M)
  511 CONTINUE 
      CALL PRMSG(MSG2,48,NOLINE,KOUNT,LINE,NMOSTA,NUNIT,NOHEAD)
      ENDIF
C
C Remapping mini run bulletin
      IF(NB.EQ.4) THEN
      DO 512 M=1,NOLINE 
      DO 512 K=1,48 
          MSG4(K,M)=MSG(K,M)
  512 CONTINUE 
      CALL PRMSG(MSG4,48,NOLINE,KOUNT,LINE,NMOSTA,NUNIT,NOHEAD)
      ENDIF
C
      CALL W3TAGE('LMP_LAVTXT')
C
 415  CONTINUE
      STOP
      END