C$$$ MAIN PROGRAM DOCUMENTATION BLOCK *** C C MAIN PROGRAM: MDL_GFSMAVTX C PRGMMR: ERICKSON ORG: OST22 DATE: 2002-01-11 C C ABSTRACT: GENERATES THE SHORT-RANGE GFS TEXT BULLETIN "MAV" C CONTAINING GFS BASED OBJECTIVE GUIDANCE FOR STATIONS IN C U.S., AK, HAWAII & PUERTO RICO. C FORECASTS ARE GIVEN EVERY 3 HOURS FROM 24 TO 60 HOURS. C AND EVERY 6 FROM 60 TO 72. C THIS BULLETIN IS SENT OUT UNDER 10 SEPERATE WMO HEADERS C AND PILS FOR DIFFERENT GROUPS OF STATIONS. (FORMERLY C CALLED AVNMAVTX) C C PROGRAM HISTORY LOG: C 00-05-19 ALLEN - STARTED WITH AVNFEX BULLETIN CODE. C MODIFIED TO CALL RDLNK ROUTINE. C 00-05-22 MCE - MODIFIED TO PRINT FIRST THREE LINES OF MESSAGE C 00-05-23 MCE - MODIFIED TO HANDLE NEW MX/MN, TMP/DPT, WDR/SPD C NOW CALLS READ_MOSDA BY DALLAVALLE & DREWRY C 00-05-25 MCE - MODIFIED TO MAKE SURE 66 & 72 HR FCSTS WERE C PUT OUT CORRECTLY, AND TO SET WDIR TO 0 WHEN C SPEED IS ZERO C 00-06-01 MCE - MODIFIED TO CORRECT DATES IN SECOND LINE C THE DAY OF MONTH SHOULD NOT HAVE LEADING C ZERO AND SHOULD BE ONE SPACE FURTHER TO RIGHT C ALSO MODIFIED TO SWITCH BETWEEN X/N AND C N/X LABEL FOR MAX/MIN TEMP LINE. C 00-06-30 MCE - MODIFIED TO ADD CLD,CIG,TYP,POZ & POS LINES C NOTE THAT LINE IS NOW SET TO 14. C 00-09-08 MCE - MODIFIED TO MOVE TYP LINE BELOW POZ AND POS C ALSO ADDED 6- AND 12-H POPS C LINE NOW SET TO 16. C 00-09-11 MCE - TOOK CARE OF P12 VALUES FOR HAWAII. C 00-09-12 MCE - MODIFIED TO ADD TSTM/SVR VALUES C 00-09-27 MCE - MODIFIED TO ADD VIS/OBVIS FORECASTS. C LINE IS NOW SET TO 20. C 00-10-02 MCE - FIXED VISIBILITY CALL TO PUTMOS, HIGH VAL OF 7 C 01-02-22 RLA - CHANGED SOME IDS TO REFLECT CHANGES IN THE C CATEGORICAL AND CONSISTENCY CHECK ID SCHEME. C ADDED COMMENTS ABOUT WHAT WE DO TO THE WIND C DIRECTION AND SPEED. C 01-06-19 MCE - ADDED QPF C 01-08-30 MCE - MODIFIED TO READ IN THE NUMBER OF HAWAII C STATIONS AS A VARIABLE. THIS WAS HARD WIRED C IN CODE BEFORE. REDUCED NUMBER OF BLANK LINES C READ IN TO 1(BFILE). C 01-08-31 MCE - MODIFIED TO HANDLE 06/18 UTC GUIDANCE. C CANT BE FULLY TESTED UNTIL HAVE MX/MN C 01-10-16 MCE - FIXED FOR P12 AND Q12 DIFF PROJ/POS AT 06/18. C 01-10-31 MCE - FIXED MAX/MIN PROJECTIONS FOR 06/18 C ALSO FIXED T12 PROJECTIONS & POSITIONS C 01-11-28 RLC - INCREASED MAXSTA TO 3000 TO ACCOMMODATE THE C INCREASE TO 1432 MOS SITES C 02-01-09 RLC - CHANGED CALL TO READ_MOSDA TO MATCH THE VERSION C IN MDLLIB C 02-05-06 MCE - ADDED FURTHER CYCLE CHECKS TO HANDLE HI P/Q12 C 03-04-16 RLC - INCREASED MAXSTA TO 3500 TO HANDLE NEW MARINE C SITES AND NEW MOS SITES TO BE ADDED IN THE FALL. C CHANGED WIND SPEED ID FROM 204325 TO 204335 C CHANGED WIND DIR ID FROM 204225 TO 204235 C 03-11-17 RLC - AS PART OF THE GFS TRANSITION, CHANGED AVN IN C HEADER LINE TO READ GFS. C 03-11-19 RLC - ADDED 24-H SNOWFALL TO MESSAGE. CHANGED NAME OF C CODE TO GFSMAVTX. C C USAGE: C C SEE BELOW FOR MDL STANDARDS C C PROGRAM GFSMAVTX C C DATA SET USE C READ(5... - STANDARD INPUT /nwprod/parm/tdl_avnmavtx.dat 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 *FORT.65(FTN65) - TRANSMISSION FILE (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** IDYWK=INTEGER DAY OF THE WEEK (1 - 7) C** IMO(3)=ARRAY USED TO HELP CALCULATE CALENDER DAY 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** LOC(5,4)=POSITION OF "/" IN DATE LINE C** LOCD(4,4)=MSG POSITION ARRAY (HR,CYC) C** LINE=NUMBER OF LINES REQUIRED PER STATION C** MM( )=ARRAY USED TO HOLD THE MDL IDENTIFIERS FOR THE C** MAX/MIN TEMPERATURE FORECAST-FOR ALL CYCLES. 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** NCAT=CHARACTER*5 CATELOG NUMBER 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 US 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 2500 STATIONS MAX C C C ATTRIBUTES: C LANGUAGE: XLF90 C MACHINE: IBM SP C C$$$ PROGRAM GFSMAVTX PARAMETER(NOCHAR=69,MAXSTA=3500,LINE=23,NUMDAY=4) PARAMETER(NOHEAD=1,ND7=54) INTEGER KOUNT(LINE,MAXSTA),IDA(4),MO(NUMDAY),IYR(NUMDAY), * MM(5,4),LOC(5,4),LOCD(4,4),NWMO(MAXSTA),IOPT,JBLOCK(MAXSTA), * JNERR,KUNIT,JUNIT,IUNIT,NUNIT,NDATE,NSTA,ID(4),ISW,NERR, * NMOSTA,LDATE,IDATE,KUT,IFLAG,IERR,MDG,MHG,MOG,MYG,NHEAD, * JDY,INC,JWBAN(MAXSTA),JDATE,MYGA,IDYWK,IDAT(8),JDAY,IMO(4), * ND5,ICY,INDEX(MAXSTA,5),IPTST,KPOS,KD(4),NHI,IS0(ND7), * IS1(ND7),IS2(ND7),IS4(ND7) REAL FCST(MAXSTA),FCST1(MAXSTA) CHARACTER*1 MSG(NOCHAR,MAXSTA*LINE+NOHEAD),NBLAK,NFILL,VBAR CHARACTER*1 POPT(4) CHARACTER*2 CLD(5),OBV(6) CHARACTER*4 CMNTH(12) CHARACTER*5 CTYPE,NCAT 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/,NOUT/65/,NUNIT/60/,NHI/0/ DATA NBLAK/' '/,NFILL/'^'/,LBULHD/11/,KFILD/27/,KFILDO/6/ DATA KFILX/48/,IPTST/0/ DATA CLD/'CL','SC','BK','OV','XX'/,POPT/'Z','S','R','X'/ DATA OBV/' N','HZ','BR','FG','BL','XX'/ DATA CMNTH/'JAN ','FEB ','MAR ','APR ','MAY ','JUNE','JULY', * 'AUG ','SEPT','OCT ','NOV ','DEC '/ DATA MM/202120008,202220008,202120008,202220008,202120008, * 202120008,202220008,202120008,202220008,202120008, * 202220008,202120008,202220008,202120008,202220008, * 202220008,202120008,202220008,202120008,202220008/ DATA LOC/24,36,48,60,66,18,30,42,54,63, * 24,36,48,60,66,18,30,42,54,63/ DATA LOCD/5,25,49,67,5,19,43,64,5,13,37,61,5,31,55,79/ C C DATA NEW/0/ C HOUR PROJECTIONS ARE 24,36,48,60,72 DATA NCAT/'00000'/ DATA IOPT/0/,NMOSTA/0/,ISW/1/,NDATE/0/,IDATE/0/,LDATE/0/ DATA MDATE/0/,JDATE/0/,NHEAD/0/,IDYWK/0/,NESTA/0/ DATA IDAT/0,0,0,-0500,0,0,0,0/ CALL W3TAGB('MDL_GFSMAVTX',2002,0011,0066,'OST22') 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 TRANSMISSION BULLETIN FILE "BFILE" (OUTPUT) READ(JUNIT,103) BFILE 103 FORMAT(A80) WRITE(KFILDO,104) BFILE 104 FORMAT(' ',A80) READ(JUNIT,105) NHI 105 FORMAT(I3) WRITE(KFILDO,106) NHI 106 FORMAT(' HAWAII SITES:',I3) C READ BULLETIN HEADERS AND STATIONS 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 FILL THE MESSAGE ARRAY WITH BLANKS EXCEPT FOR THE 1ST CHARACTER 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 READ NMC STANDARD DATE FILE C PUT DATE IN MDL FORMAT C CALL GET_NCEPDATE(IUNIT,MYG,MOG,MDG,MHG,LDATE,IERR) IF(IERR.NE.0) THEN CALL W3TAGE('MDL_GFSMAVTX') STOP 115 ENDIF C FIND VALID DATES FOR HEADINGS. C FOR 3 CALENDER DAYS C THIS WILL NEED ADJUSTING FOR 4 CYCLES C ICY=(MHG/6) + 1 MDATE=LDATE 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).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***** START CONSTRUCTION OF THE C***** BULLETIN C***** C PLACE HEADER INFO FOR EACH STATION C DO 140 K=1,NMOSTA C C BUILD 1ST LINE CALL PUTCHAR('$',MSG(1,(K-1)*LINE+2),1) CALL PUTCHAR(CCALL(K,1),MSG(2,(K-1)*LINE+2),4) CALL PUTCHAR('GFS MOS GUIDANCE',MSG(9,(K-1)*LINE+2),16) 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) CALL PUTCHAR('00 UTC',MSG(42,(K-1)*LINE+2),6) CALL PUTMOS('MHG',FLOAT(MHG),0.,1.,0,18,MSG(40,(K-1)*LINE+2), * 2,2,'99',KX) KOUNT(1,K)=1 C C PLACE DATE HEADER (SECOND LINE) C CALL PUTCHAR('DT',MSG(2,(K-1)*LINE+3),2) DO 119 J=1,3 CALL PUTCHAR('/',MSG(LOCD(J,ICY),(K-1)*LINE+3),1) CALL PUTCHAR(CMNTH(IMO(J)),MSG(LOCD(J,ICY)+1,(K-1)*LINE+3),4) CALL PUTMOS('DAY',FLOAT(IDA(J)),0.,1.,0,31,MSG(LOCD(J,ICY)+6, * (K-1)*LINE+3),2,0,'99',KX) 119 CONTINUE IF(MHG.NE.18) THEN CALL PUTCHAR('/',MSG(LOCD(4,ICY),(K-1)*LINE+3),1) ENDIF IF(MHG.EQ.12) THEN CALL PUTCHAR(CMNTH(IMO(J)),MSG(LOCD(4,ICY)+1,(K-1)*LINE+3),4) CALL PUTMOS('DAY',FLOAT(IDA(J)),0.,1.,0,31,MSG(LOCD(4,ICY)+6, * (K-1)*LINE+3),2,0,'99',KX) ENDIF KOUNT(2,K)=1 C C PLACE HOUR HEADERS (THIRD LINE) C CALL PUTCHAR('HR',MSG(2,(K-1)*LINE+4),2) IHR=MHG+3 IPOS=4 DO 136 J=1,21 IHR=IHR+3 IPOS=IPOS+3 C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(J.GE.20) IHR=IHR+3 IF(IHR.EQ.24) IHR=0 CALL PUTMOS('HOUR',FLOAT(IHR),0.,1.,0,24,MSG(IPOS, * (K-1)*LINE+4),2,2,'99',KX) 136 CONTINUE KOUNT(3,K)=1 C C PLACE FORECAST ELEMENT NAMES C IF((ICY.EQ.1).OR.(ICY.EQ.2)) THEN CALL PUTCHAR('X/N',MSG(2,(K-1)*LINE+5),3) ELSE CALL PUTCHAR('N/X',MSG(2,(K-1)*LINE+5),3) ENDIF CALL PUTCHAR('TMP',MSG(2,(K-1)*LINE+6),3) CALL PUTCHAR('DPT',MSG(2,(K-1)*LINE+7),3) CALL PUTCHAR('CLD',MSG(2,(K-1)*LINE+8),3) CALL PUTCHAR('WDR',MSG(2,(K-1)*LINE+9),3) CALL PUTCHAR('WSP',MSG(2,(K-1)*LINE+10),3) CALL PUTCHAR('P06',MSG(2,(K-1)*LINE+11),3) CALL PUTCHAR('P12',MSG(2,(K-1)*LINE+12),3) CALL PUTCHAR('Q06',MSG(2,(K-1)*LINE+13),3) CALL PUTCHAR('Q12',MSG(2,(K-1)*LINE+14),3) CALL PUTCHAR('T06',MSG(2,(K-1)*LINE+15),3) CALL PUTCHAR('T12',MSG(2,(K-1)*LINE+16),3) CALL PUTCHAR('POZ',MSG(2,(K-1)*LINE+17),3) CALL PUTCHAR('POS',MSG(2,(K-1)*LINE+18),3) CALL PUTCHAR('TYP',MSG(2,(K-1)*LINE+19),3) CALL PUTCHAR('SNW',MSG(2,(K-1)*LINE+20),3) CALL PUTCHAR('CIG',MSG(2,(K-1)*LINE+21),3) CALL PUTCHAR('VIS',MSG(2,(K-1)*LINE+22),3) CALL PUTCHAR('OBV',MSG(2,(K-1)*LINE+23),3) KOUNT(LINE,K)=-1 C ABOVE STATEMENT PROVIDES FOR BLANK LINE. 140 CONTINUE C CCCCCCCCCC CCCCCCCCCC C C PLACE MAX/MIN FCSTS C 00/12Z FCSTS STORED AT TAU + 6 (24MX/MN IS 30) C 06/18Z FCSTS ARE AT 24, 36, ETC ID(1)=0 ID(2)=0 IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN ID(3)=18 ELSE ID(3)=12 ENDIF ID(4)=0 INC=12 DO 160 K=1,5 ID(1)=MM(K,ICY) ID(3)=ID(3)+INC CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.EQ.3) THEN CALL W3TAGE('MDL_GFSMAVTX') STOP 3 ENDIF IF(IER.LT.2) KUT=KUT+1 DO 150 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,1.,-99,999, * MSG(LOC(K,ICY),(J-1)*LINE+5),3,0,'999',KOUNT(4,J)) 150 CONTINUE 160 CONTINUE C C PLACE TEMP FORECASTS C ID(1)=202020008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=3 DO 180 K=1,21 ID(3)=ID(3)+INC IPOS=IPOS+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * 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, * (J-1)*LINE+6),3,0,'999',KOUNT(5,J)) 170 CONTINUE 180 CONTINUE C C PLACE DEW POINT FORECASTS C ID(1)=203020008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=3 DO 200 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * 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, * (J-1)*LINE+7),3,0,'999',KOUNT(6,J)) 190 CONTINUE 200 CONTINUE C C PLACE CLD FORECASTS C (2/2001-CHANGED ID FROM 208340) C ID(1)=208341008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=4 DO 208 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 205 J=1,NMOSTA IF(FCST(J).LT.9999.) THEN KOUNT(7,J)=1 ELSE FCST(J)=5. ENDIF CALL PUTCHAR(CLD(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+8),2) 205 CONTINUE 208 CONTINUE C C PLACE WIND DIRECTION FORECASTS C 4/2003 - CHANGED THIS ID FROM 204225 TO THE NEW MARINE C ADJUSTED WIND DIR ID 204235. C ID(1)=204235008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=4 DO 220 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * 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, * (J-1)*LINE+9),2,2,'99',KOUNT(8,J)) 210 CONTINUE 220 CONTINUE C C PLACE WIND SPEED FORECASTS C 4/2003 - CHANGED THIS ID FROM 204325 TO THE NEW MARINE C ADJUSTED WIND SPEED ID 204335. FOR THE MAIN MOS SITES C THE 204325 SPEED AND ADJUSTED WIND SPEED WILL BE THE C SAME BECAUSE THE MOS SITE WIND SPEED ARE ALREADY AT C 10 METERS C ID(1)=204335008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=4 DO 240 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * 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+9),2) ENDIF CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,98,MSG(IPOS, * (J-1)*LINE+10),2,2,'99',KOUNT(9,J)) 230 CONTINUE 240 CONTINUE C C PLACE P06 FORECASTS C ID(1)=203220108 ID(2)=0 ID(3)=6 ID(4)=0950052000 INC=6 IPOS=6 DO 250 K=1,11 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.10) IPOS=IPOS-3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 245 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS, * (J-1)*LINE+11),3,0,'999',KOUNT(10,J)) 245 CONTINUE 250 CONTINUE C C PLACE P12 FORECASTS C (2/2001-CHANGED FROM 203322) C ID(1)=203330108 ID(2)=0 IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN ID(3)=12 IPOS=12 KD(3)=06 KPOS=06 ELSE ID(3)=06 IPOS=06 KD(3)=12 KPOS=12 ENDIF ID(4)=0950052000 KD(1)=203330108 KD(2)=0 KD(4)=0950052000 INC=12 DO 260 K=1,5 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE CLOSER TOGETHER IF(K.GE.5) THEN IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN IPOS=IPOS-6 ELSE IPOS=IPOS-3 ENDIF ENDIF CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 255 J=NHI+1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS, * (J-1)*LINE+12),3,0,'999',KOUNT(11,J)) 255 CONTINUE C NOW PROCESS HAWAIIN STNS- PROJ 6HRS EARLIER KD(3)=KD(3)+INC KPOS=KPOS+INC IF(K.GE.5) THEN IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN KPOS=KPOS-3 ELSE KPOS=KPOS-6 ENDIF ENDIF CALL READ_MOSDA(KFILDO,KFILX,IPTST,KD,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) DO 256 J=1,NHI CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(KPOS, * (J-1)*LINE+12),3,0,'999',KOUNT(11,J)) 256 CONTINUE 260 CONTINUE C C PLACE Q06 FORECASTS C ID(1)=203221008 ID(2)=0 ID(3)=6 ID(4)=0 INC=6 IPOS=8 DO 270 K=1,11 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.10) IPOS=IPOS-3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 265 J=1,NMOSTA IF(FCST(J).LT.9999.) THEN FCST(J)=FCST(J) - 1. ENDIF CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,9,MSG(IPOS, * (J-1)*LINE+13),1,0,'9',KOUNT(12,J)) 265 CONTINUE 270 CONTINUE C C PLACE Q12 FORECASTS C ID(1)=203331008 ID(2)=0 IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN ID(3)=12 IPOS=14 KD(3)=06 KPOS=08 ELSE ID(3)=06 IPOS=08 KD(3)=12 KPOS=14 ENDIF ID(4)=0 KD(1)=203331008 KD(2)=0 KD(4)=0 INC=12 DO 280 K=1,5 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE CLOSER TOGETHER IF(K.GE.5) THEN IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN IPOS=IPOS-6 ELSE IPOS=IPOS-3 ENDIF ENDIF CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 275 J=NHI+1,NMOSTA IF(FCST(J).LT.9999.) THEN FCST(J)=FCST(J) - 1. ENDIF CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,9,MSG(IPOS, * (J-1)*LINE+14),1,0,'9',KOUNT(13,J)) 275 CONTINUE C NOW PROCESS HAWAIIN STNS- PROJ 6HRS EARLIER KD(3)=KD(3)+INC KPOS=KPOS+INC IF(K.GE.5) THEN IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN KPOS=KPOS-3 ELSE KPOS=KPOS-6 ENDIF ENDIF CALL READ_MOSDA(KFILDO,KFILX,IPTST,KD,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) DO 276 J=1,NHI IF(FCST(J).LT.9999.) THEN FCST(J)=FCST(J) - 1. ENDIF CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,9,MSG(KPOS, * (J-1)*LINE+14),1,0,'9',KOUNT(13,J)) 276 CONTINUE 280 CONTINUE C C PLACE T06 FORECASTS C ID(1)=207220108 ID(2)=0 ID(3)=6 ID(4)=0950000000 KD(1)=207265108 KD(2)=0 KD(3)=6 KD(4)=0950000000 INC=6 IPOS=3 DO 290 K=1,10 IPOS=IPOS+INC C LAST PROJECTION SHOULD BE 72, 66-H IS SKIPPED IF(K.GE.10) INC=INC+6 ID(3)=ID(3)+INC KD(3)=KD(3)+INC CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 CALL READ_MOSDA(KFILDO,KFILX,IPTST,KD,LDATE,CCALL, * NMOSTA,FCST1,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 285 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS, * (J-1)*LINE+15),3,1,'999',KOUNT(14,J)) CALL PUTCHAR('/',MSG((IPOS+3),(J-1)*LINE+15),1) CALL PUTMOS(LIST(J),FCST1(J),0.,100.,0,98,MSG((IPOS+4), * (J-1)*LINE+15),2,1,'99',KOUNT(14,J)) 285 CONTINUE 290 CONTINUE C C PLACE T12 FORECASTS C (2/2001-CHANGED FROM 207322 AND 207367) C ID(1)=207330108 ID(2)=0 IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN ID(3)=6 KD(3)=6 IPOS=3 ELSE ID(3)=12 KD(3)=12 IPOS=9 ENDIF ID(4)=0950000000 KD(1)=207375108 KD(2)=0 KD(4)=0950000000 INC=12 DO 300 K=1,5 IPOS=IPOS+INC ID(3)=ID(3)+INC KD(3)=KD(3)+INC C LAST COLUMN NEEDS TO BE SQUEEZED IN A BIT IF(K.GE.5) THEN IF((ICY.EQ.1).OR.(ICY.EQ.3)) THEN IPOS=IPOS-3 ELSE IPOS=IPOS-6 ENDIF ENDIF CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 CALL READ_MOSDA(KFILDO,KFILX,IPTST,KD,LDATE,CCALL, * NMOSTA,FCST1,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 295 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS, * (J-1)*LINE+16),3,1,'999',KOUNT(15,J)) CALL PUTCHAR('/',MSG((IPOS+3),(J-1)*LINE+16),1) CALL PUTMOS(LIST(J),FCST1(J),0.,100.,0,98,MSG((IPOS+4), * (J-1)*LINE+16),2,1,'99',KOUNT(15,J)) 295 CONTINUE 300 CONTINUE C C SKIP FREEZING RAIN, SNOW, PRECIP TYPE, AND SNOWFALL FORECASTS C IF DATE IS AFTER MAY 31 AND BEFORE SEP 01. JDATE=(MOG*100)+MDG IF ((JDATE.GT.531).AND.(JDATE.LT.901)) GOTO 321 C C PLACE POZ FORECASTS C ID(1)=208545308 ID(2)=0 ID(3)=3 ID(4)=0350001000 INC=3 IPOS=3 DO 308 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 305 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS, * (J-1)*LINE+17),3,0,'999',KOUNT(16,J)) 305 CONTINUE 308 CONTINUE C C PLACE POS FORECASTS C ID(1)=208545308 ID(2)=0 ID(3)=3 ID(4)=0450001000 INC=3 IPOS=3 DO 315 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 310 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,100.,0,100,MSG(IPOS, * (J-1)*LINE+18),3,0,'999',KOUNT(17,J)) 310 CONTINUE 315 CONTINUE C C PLACE PTYPE FORECASTS C (2/2001-ID CHANGED FROM 208545) C ID(1)=208546008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=5 DO 320 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 317 J=1,NMOSTA IF(FCST(J).LT.9999.) THEN KOUNT(18,J)=1 ELSE FCST(J)=4. ENDIF CALL PUTCHAR(POPT(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+19),1) 317 CONTINUE 320 CONTINUE C C PLACE 24H SNOWFALL FORECASTS C ADDED NOV/DEC 2003 C ID(1)=208461008 ID(2)=0 ID(4)=0 INC=24 IF(ICY.EQ.1)THEN ID(3)= 18 IPOS = 14 NUM = 2 ENDIF IF(ICY.EQ.2)THEN ID(3)= 12 IPOS = 8 NUM = 2 ENDIF IF(ICY.EQ.3)THEN ID(3)= 6 IPOS = 2 NUM = 3 ENDIF IF(ICY.EQ.4)THEN ID(3)= 24 IPOS = 20 NUM = 2 ENDIF DO 322 K=1,NUM IPOS=IPOS+INC ID(3)=ID(3)+INC IF((ICY.EQ.4).AND.(K.EQ.NUM))IPOS=IPOS-3 IF((ICY.EQ.3).AND.(K.EQ.NUM))IPOS=IPOS-6 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 325 J=1,NMOSTA IF(FCST(J).LT.9999.) THEN FCST(J)=FCST(J) - 1. ENDIF CALL PUTMOS(LIST(J),FCST(J),0.,1.,0,9,MSG(IPOS, * (J-1)*LINE+20),1,0,'9',KOUNT(19,J)) 325 CONTINUE 322 CONTINUE C C PLACE CEILING (CIG) FORECASTS C (2/2001-CHANGED ID FROM 208040) C 321 ID(1)=208041008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=5 DO 330 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 327 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,1.,1,7,MSG(IPOS, * (J-1)*LINE+21),1,1,'9',KOUNT(20,J)) 327 CONTINUE 330 CONTINUE C C PLACE VISIBILITY (VIS) FORECASTS C (2/2001-CHANGED ID FROM 208120) C ID(1)=208121008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=5 DO 340 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 337 J=1,NMOSTA CALL PUTMOS(LIST(J),FCST(J),0.,1.,1,7,MSG(IPOS, * (J-1)*LINE+22),1,1,'9',KOUNT(21,J)) 337 CONTINUE 340 CONTINUE C C PLACE OBSTRUCTION TO VISION (OBV) FORECASTS C (2/2001-CHANGED ID FROM 208290) C ID(1)=208291008 ID(2)=0 ID(3)=3 ID(4)=0 INC=3 IPOS=4 DO 350 K=1,21 IPOS=IPOS+INC ID(3)=ID(3)+INC C THE LAST TWO COLUMNS OF MESSAGE ARE INCREMENTED BY 6 IF(K.GE.20) ID(3)=ID(3)+3 CALL READ_MOSDA(KFILDO,KFILX,IPTST,ID,LDATE,CCALL, * NMOSTA,FCST,MAXSTA,ND5,ND7,IS0,IS1,IS2,IS4, * INDEX,IER) IF(IER.LT.2) KUT=KUT+1 DO 347 J=1,NMOSTA IF(FCST(J).LT.9999.) THEN KOUNT(22,J)=1 ELSE FCST(J)=6. ENDIF CALL PUTCHAR(OBV(NINT(FCST(J))),MSG(IPOS,(J-1)*LINE+23),2) 347 CONTINUE 350 CONTINUE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C COMMENTED OUT PRIOR TO 11/95 REVISION: C PATCH TO FORCE MISSING ELEMENTS TO BE IN MESSAGE. C DO 333 M=1,NMOSTA C DO 333 K=1,LINE C IF (K.NE.LINE) KOUNT(K,M)=1 C333 CONTINUE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF (KUT.LE.0) THEN WRITE(6,390) 390 FORMAT(//'0NO GFS MOS FORECASTS FOUND.') CALL W3TAGE('MDL_GFSMAVTX') STOP 70 ENDIF C C FOR EACH WMO HEADER, WRITE THE MESSAGE TO THE TRAN FILE. DO 400 N=1,NHEAD NBSTA=NESTA+1 NESTA=NESTA+NWMO(N) CBULHD=WMO(N) CALL WRMSGA(MSG,NOCHAR,NOLINE,NBSTA,NESTA,LINE,NCAT,KOUNT, * LINE,NMOSTA,CBULHD,LBULHD,MDG,MHG,NOHEAD,NOUT,BFILE,NHEAD) 400 CONTINUE C C PRINT MESSAGE C CALL PRMSG(MSG,NOCHAR,NOLINE,KOUNT,LINE,NMOSTA,NUNIT,NOHEAD) C CALL W3TAGE('MDL_GFSMAVTX') STOP END