SUBROUTINE OPTX(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,TRESHL,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 LASTL,LASTD,NBLOCK,NSTORE,NFETCH, 6 IS0,IS1,IS2,IS4,ND7, 7 L3264B,L3264W,ISTAB,IER) C C SEPTEMBER 1996 GLAHN TDL MOS-2000 C DECEMBER 1996 GLAHN ADDED CONSTANT FILE ACCESS C JANUARY 1996 GLAHN NAME CHANGE OPT600 TO OPTX, C TRESHU OMITTED C JANUARY 1997 GLAHN NELEV( ), STALAT( ), STALON( ) ELIMINATED C JANUARY 1997 GLAHN ADDED LASTL, LASTD TO CALLS C AUGUST 1997 GLAHN INCREASED DIMENSIONS OF CCALL( ) TO C ACCOMMODATE SUBSTITUTE STATIONS. C JUNE 1998 GLAHN ADDED ITAU TO CALL C AUGUST 1998 GLAHN ADDED CALL TO DIFFV C SEPTEMBER 1998 GLAHN COMMENT: RETURNED VARIABLE IS NOT BINARY C OCTOBER 1998 GLAHN ISTAV ADDED TO CALL; NUMIN AND INDEXC( ) C REMOVED C OCTOBER 1998 GLAHN CHANGED CALL TO CONST FROM CONSTX C FEBRUARY 1999 GLAHN CHANGED ORDER OF CALL TO TIMEPV AND VERTX C APRIL 1999 GLAHN ADDED MPSKTS, DIRFUV WITH ITAU IN CALL C ADDED MDATE IN CALL TO OPTX C APRIL 1999 GLAHN ADDED ZRONEG; TRANSFER TO 300 ON C IER = 120 FROM CONST/FINDST C APRIL 1999 GLAHN ADDED POPDIF C MAY 1999 GLAHN ADDED FTOKEL C JUNE 1999 GLAHN ADDED TRUNCP AND NMLPRB C JULY 1999 GLAHN ADDED IP12, KFILRA( ), RACESS( ), NUMRA, C NCAT, ISTAB; CHANGED WHERE CONST CALLED C AUGUST 1999 GLAHN ISTAV SET = 1 AT BEGINNING C SEPTEMBER 1999 GLAHN CHANGED CALL TO NORWND; C ADDED DIAGNOSTIC 1980 C SEPTEMBER 1999 GLAHN ADDED ISTAB TO CALL TO NMLBRB AND TRUNCP C APRIL 2000 GLAHN REMOVED NCAT AND ISTAB IN CALL TO DIRCALM; C CORRECTED CALL TO MPSKTS, ZRONEG, NORWND; C INDENTED CALLS TO MAXTEST, MRFTEST, KWHTOJ; C CHECKED SPELLING; FORMAT STATEMENTS C FORTRAN 90 COMPATIBLE; ADDED /, IN C **** COMMENTS C APRIL 2000 GLAHN MODIFIED FOR CALL TO OPFCST C APRIL 2000 GLAHN ADDED ISTAB TO CALL TO OPFCST C MAY 2000 GLAHN CHANGED IDPARS(3) TO (4) IN OPFCST CALL; C REMOVED DUPLICATE CALL TO OPFCST C MAY 2000 GLAHN CHANGED A COUPLE OF CALLS; SPELLING C MAY 2000 DALLAVALLE ADDED COMMAS TO FORMAT STATEMENTS; C MAY 2000 DALLAVALLE MODIFIED CALL TO SUBROUTINE OPFCST C SO THAT A SEARCH FOR OBSERVATIONS C WILL NOT PASS INTO OPFCST C MAY 2000 GLAHN CALL TO OPFCST ONLY FOR OPERATIONAL C FORECASTS FROM THE ETA, AVN, OR MRF C MODELS; MODIFIED FORMATS 198 AND 1980 C JUNE 2000 GLAHN CORRECTED CALL TO NORWND C JUNE 2000 RUDACK ADDED CALLS TO SUBROUTINES CATGR1, C POPXCON, AND MONPRB. MODIFIED THE C CALL TO NMLPRB. ADDED AN ARGUMENT (NCAT) C IN THE CALL TO OPFCST TO ALLOW C MULTIPLE PROBABILITY CATEGORIES TO C BE PROCESSED. C JULY 2000 GLAHN ADDED TESTS TO NOT CALL CONST WHEN C NUMRA = 0 AND WHEN DD = 80-82. C JULY 2000 DAGOSTARO ADDED TEST TO NOT CALL CONST WHEN C DD=6 (NGM FORECAST). C JULY 2000 RUDACK ADDED CHECK OF "IDPARS(3)" IN THE ELSEIF C OF 'MONPRB', 'POPXCON' AND C 'CATGR1' C JULY 2000 RUDACK COMMENTED OUT 'TRUNCP' BECAUSE 'MONPRB', C AT THIS POINT IN TIME, PERFORMES THE SAME C FUNCTION; ADDED SUBROUTINE 'CMPPRB' C AUGUST 2000 DAGOSTARO REPLACED CALL TO POPDIF WITH CALL TO C FCSTDF. C AUGUST 2000 RUDACK ADDED ID'S FOR VISIBILITY AND OBSTRUCTION C OF VISION TO THE CALLS IN 'MONPRB' AND C 'NMLPRB' RESPECTIVELY. ADDED ID IN 'NMLPRB' C FOR AVERAGE CLOUD AMOUNT FOR A 12-HR C PERIOD C SEPTEMBER 2000 DALLAVALLE CORRECTED ID FOR OBSTRUCTION TO C VISION. ADDED ID IN NMLPRB FOR POPC C AND PRECIP. TYPE OVER A 12-H PERIOD. C ADDED ID'S FOR VIS, OBVIS, AVERAGE C CLOUD AMOUNT FOR A 12-H PERIOD, C 12-H PRECIP. TYPE, AND POPC. C OCTOBER 2000 GLAHN CHANGED "AND" TO "OR" IN CALL TO CONST C JANUARY 2001 ALLEN REMOVED IDS NOT CURRENTLY IN USE FROM THE C CALLS TO FTOKEL AND KTSMPS C FEBRUARY 2001 ALLEN ADDED AVN QPF TO CALL TO CATGR1 AND CMPPRB, C CHANGED CATEGORICAL IDS IN CALL TO CATGR1, C CHANGED CONSISTENCY CHECK IDS IN CALL TO C CMPPRB C MARCH 2001 ALLEN ADDED IDS FOR RFC MAX/MIN TO CALL FOR MRFTEST C MAY 2001 ANTOLIK ADDED 6-H QPF ID TO CALL FOR POPXCON C JANUARY 2002 RLC THE CODE POPXCON IS NOW CALLED PROBXCON C CHANGED THE CALL. C JULY 2002 RLC MODIFIED THE CALL TO MONPRB TO ALLOW C TRUNCATION OF POPO/POPO3 C AUGUST 2002 SFANOS/ MODIFIED NMLPRB, KTSMPS, AND ZRONEG CALLS C MCE FOR MRF WIND SPEED C NOVEMBER 2002 JPD MODIFIED CALLS TO DIRFUV, KTSMPS, DIRCALM, C AND ZRONEG TO ADD ID'S REQUIRED TO PROCESS C MODIFIED PERFECT PROG WINDS PRODUCED C FOR THE NGM MARINE WIND SYSTEM. C ADDED CALL TO KTOF SUBROUTINE. C ADDED CALL TO CONVQPF SUBROUTINE, WHICH C CONVERTS NGM MOS QPF CATEGORICAL C FORECASTS TO VALUES CONSISTENT WITH C DIRECT MODEL OUTPUT AND OTHER MOS2000 C FORECAST VALUES. C ADD IF TEST TO AVOID CALL TO CONST, WHEN C THE MODEL DD=08. THIS TEST WAS ADDED C BY DAGOSTARO IN APRIL 2001, AND WILL C HAVE TO BE MONITORED CLOSELY TO ENSURE C THAT PROBLEMS DO NOT OCCUR. C THESE VARIOUS MODIFICATIONS WERE MADE C BY ANTOLIK, CARROLL, MCALOON, AND C DAGOSTARO AT VARIOUS TIMES BETWEEN C 1999 AND 2001. C MARCH 2003 MCALOON ADDED IDS TO DIRCALM CALL TO ACCOMMODATE C HEIGHT ADJUSTED WIND DIRECTION. C APRIL 2003 MCALOON ADDED IDS TO KTSMPS CALL TO ACCOMMODATE C HEIGHT ADJUSTED WIND SPEED. C JUNE 2003 TRIMARCO ADDED IDS FOR 3HR THUNDERSTORMS AND C SEVERE WEATHER WITH THE CALL TO MONPRB C JUNE 2003 RLC ADDED IDS TO PROBXCON, MONPRB, CATGR1 TO C ACCOMMODATE SNOWFALL FORECASTS C NOVEMBER 2003 JOE ADDED CALL TO FIXPRB AND FIXCAT. C MODIFIED CALLS TO NMLPRB AND CATGR1 TO C USE NEW CIG/CLD IDS C NOVEMBER 2003 RLC CHANGED THE NMLPRB AND CATGR1 CALLS C TO USE THE OLD CIG/CLD IDS FOR THE ETA C UNTIL FEBRUARY. C DECEMBER 2003 GLAHN ADDED CALL TO CBNPRB AND WHEN IER = 191 C RETURN IS MADE DIRECTLY C JANUARY 2004 GLAHN ADDED TEST ON PROJECTION FOR CALL TO TMPCMP C MARCH 2004 SHEETS MERGED 3 VERSIONS OF CODE FOR LIBRARY TEAM C MARCH 2004 YAN ADDED ID TO MONPRB TO ACCOMMODATE NEW C VISIBILITY FORECAST ID C JULY 2004 MCALOON REMOVED CHECK ON PROJECTION FOR CALL TO C TMPCMP. CALL TO DPCAMT HAS BEEN ADDED BUT C COMMENTED OUT. CALL TO MXMNFT HAS BEEN C ADDED BUT COMMENTED OUT. C JANUARY 2005 RLC ADDED CALL TO MERGIDS. C JUNE 2005 RLC TOOK NEW MOS2K LIB VERSION AND MODIFIED IT C FOR OPERATIONS. TOOK OUT CHECKS ON DD IN C FIXCAT AND FIXPRB BECAUSE WE DO IT FOR THE C ETA TOO. ADDED CALL TO ADJUV. ADDED DD=05 C TO CALL TO OPFCST. CHANGED CALLS TO NMLPRB C AND CATGR1. TOOK OUT OLD CLOUD IDS WHICH C ARE NOW HANDLED IN FIXCAT AND FIXPRB. ADDED C NEW VISIBILITY ID BACK INTO CATGR1 CALL. C JUNE 2005 RLC ADDED CALL TO RHUMID. C SEPTEMBER 2005 JOE ADDED CALL TO FIXQPFCAT, FOR GFSX BUFR. C SEPTEMBER 2005 RLC UPDATED CALL TO CMPPRB FOR TSTMS, AND CALL TO C KTSMPS FOR MEX 12-HR WIND SPEED. ADDED NEW C ROUTINE MAXWND. C MARCH 2006 RLC ADDED ADJUSTED U AND V IDS TO KTSMPS C APRIL 2006 JCM UPDATED CALLS TO MONPRB AND CATGR1 FOR WIND C GUSTS; ADDED CALL TO NEW ROUTINE GUSTDEC; C UPDATED CALL TO KTSMPS FOR WIND GUSTS C MAY 2006 JCM ADDED ABILITY TO CALL MPSKTS, KTOF, AND C PCT2DC USING CCCFFF OF NDFD FORECASTS. OTHER C VARIABLES THAT ONCE CALLED KELTOF NOW CALL C KTOF; BOTH SUBROUTINES HAVE BEEN C CONSOLIDATED WITH THE KELTOF LOGIC RETAINED C UNDER THE NEW NAME. (MERGED CHANGES FROM DEV. C BY VJD/MSA) C JUNE 2006 JRW MERGED LAMP VERSION AND MOS VERSION. LAMP C MODIFICATIONS ARE AS FOLLOWS: C JRW ADDED IDS FOR CONDITIONAL VIS TO MONPRB AND C CATGR1. ADDED IDS FOR POPO TO CATGR1. C ADDED IDS FOR LAMP CEILING HGT TO MONPRB AND C CATGR1. C ADDED IDS FOR LAMP WIND GUST TO MONPRB AND C CATGR1. C ADDED CALL GUSTPST TO POST PROCESS LAMP C WIND GUSTS C JRW ADDED CALL TO IFRCAT C CHARBA ADDED THE ROUTINE LPTSPP, WHICH PER- C FORMS POST-PROCESSING OF LAMP TSTM C PROBABILITIES. C CHARBA ADDED IDS FOR THE LAMP TSTM CATEGORI- C CAL FORECASTS TO THOSE ACCOMMODATED BY C CATGR1. C WEISS ADDED CALL TO DBTAIL FOR CONDITIONAL C CEILING HT. COMMENTED OUT CONDITIONAL VIS C CALL TO MONPRB, IS NOW ALSO CALLED BY C DBTAIL C JRW ADDED CONDITIONAL CEILING CALL TO CATGR1. C SDS ADDED NEW PCHAR IDS TO NMLPRB AND CATGR1 C JRW ADDED WIND GUST IDS TO KTSMPS. C WEISS ADDED CALL TO CIGBLOTDSC FOR C CONDITIONAL AND UNCONDITIONAL CEILING HT. C POST PROCESSING NECESSARY FOR THE C BUFRLAMP MESSAGE C JRW ADDED CALL TO DC2PCT TO CONVERT C PROBABILTY FORECASTS TO PRECENT FORECASTS. C JRW ADDED CALL TO CATMOD TO MODIFY THE C CATGEORICAL LMP TSTORM FORECASTS OUT C OF CATGR1. C SDS MODIFIED IDS FOR PCHAR IN NMLPRB, AND CATGR1. C JPC MODIFIED CALL TO LPTSPP. ADDED LASTL AND LASTD. C JPC MODIFIED TO ACCOMMODATE SMOOTHING C OF THUNDERSTORM PROBABILITIES ALONG C REGIONAL BOUNDARIES BEFORE CATEGORICAL C THUNDERSTORM FORECASTS ARE DERIVED. C JLM MODIFIED ISO TO BE IS0 C SEPTEMBER 2007 SDS MERGED LAMP VERSION AND MOS VERSION. LAMP C MODIFICATIONS ARE: C RLC ADDED IDS TO ADJSPD AND KTSMPS FOR ADJUSTED C WIND GUSTS AND MAX WIND FOR GMOS. ADDED C ROUTINE CM2DSC FOR OPAQUE SKY COVER. ADDED C SKY COVER IDS TO MONPRB AND CATGR1. C JCM ADDED CALL TO EXVALU. C ANTOLIK REPLACED CALL TO EXVALU WITH EXPVAL C JCM ADDED CALL TO ADJEXP. C RLC ADDED CALL TO CMBWNDG.F C JCM COMMENTED OUT CALL TO ADJEXP; REPLACED WITH C CALL TO ADJEXPQPF C FEBRUARY 2011 SDS ADDED OPAQUE SKY IN CALL TO CATGR1. C NOVEMBER 2011 MWS ADDED OPAQUE SKY TO CALL TO CM2DSC FOR C BUFR REQUIREMENTS. REPLACED TOTAL SKY C COVER ID WITH OPAQUE SKY COVER ID IN C CALL TO MONPRB. C FEBRUARY 2012 MWS CONSOLIDATED 2 IDENTICAL CALLS TO CM2DSC C INTO ONE CALL STATEMENT. C JUNE 2013 FGS SEVERAL UPDATES FOR UPDATED LIGHTNING C AND NEW CONVECTION. REMOVED CALL TO C LPTSPP, REMOVED 207501 FROM CALL TO C CATGR1, ADDED CALLS TO PCNVPP AND C CNVPOT, ADDED 207564 TO DC2PCT. C DECEMBER 2016 FGS ADDED PCNVPP1H, WHICH HANDLES 1H CNV C AND LTG PROBS. EXPANDED CALL TO C CNVPOT TO INCLUDE 1H CNV/LTG POT. C ADDED 1H CNV/LTG PROBS TO DC2PCT CALL C JANUARY 2020 CH ADDED CALL TO MELD SKY COVER. C JULY 2020 CH ADDED CALL TO MELD CCIG/CVIS. C FEBRUARY 2021 PS UPDATED TO ACCOMMODATE ECMWF(DD=01) C IN CALL TO OPFCST. C OCTOBER 2022 PS ADDED T/TD/W TO CALL TO OPFCSTID. C C PURPOSE C TO CALL VARIOUS COMPUTATIONAL ROUTINES FOR VRBL61, VRBL62, C FCST71, AND FCST72. WILL ALSO WORK FOR OTHER MOS-2000 C PROGRAMS SUCH AS U900. IT IS ASSUMED THE VARIABLE RETURNED C IS NOT BINARY AND ISTAB SET = 0, EXCEPT FOR CERTAIN C SUBROUTINES, AND THEN ISTAB IS SET = 1 IN THE CALLED SUBROUTINE. C OPTX AND ITS SUBROUTINES PERFORM ONLY LIMITED COMPUTATIONS. C FOR INSTANCE, BOTH VERTICAL AND TIME PROCESSING TO GET A C VARIABLE IS NOT SUPPORTED. IT IS ASSUMED, FOR INSTANCE, C THAT IF A TIME DIFFERENCE OF A THICKNESS IS TO BE COMPUTED, C THE THICKNESS IS AVAILABLE. C C DATA SET USE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS. C (INPUT-OUTPUT) C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. (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 THE MOS-2000 EXTERNAL C RANDOM ACCESS FILES (J=1,NUMRA) C RACESS(J) = THE FILE NAME FOR THE MOS-2000 EXTERNAL RANDOM C ACCESS FILE (J=1,NUMRA). (CHARACTER*60) C NUMRA = THE NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (INPUT) C ID(J) = THE VARIABLE ID (J=1,4). (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE C ID CORRESPONDING TO ID( ) (J=1,15). (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 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 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 TRESHL = THE LOWER BINARY THRESHOLD ASSOCIATED WITH IDPARS( ). C NO UPPER LIMIT TRESHU IS PROVIDED. ALTHOUGH C PREDICTANDS (NOT PREDICTORS) CAN HAVE AN UPPER LIMIT, C ALL BINARIES ARE DEALT WITH OUTSIDE OPTX. IF A VARIABLE C IS COMPUTED SPECIALLY AND IT REQUIRES AN UPPER LIMIT, C THE LIMIT WILL HAVE TO BE HARDWIRED JUST AS WILL THE C COMPUTATIONAL ALGORITHM. NOTE THAT U201 HAS MUCH C FLEXIBILITY IS USING THRESHOLDS TO COMPUTE VARIABLES. C (INPUT) C JD(J) = THE BASIC INTEGER VARIABLE ID (J=1,4). C THIS IS THE SAME AS ID(J), EXCEPT THAT THE FOLLOWING C PORTIONS ARE OMITTED: C B = IDPARS(3), C G = IDPARS(15), AND C THRESH. C JD( ) IS USED TO IDENTIFY WHICH CALCULATIONS C CAM BE MADE DIRECTLY IN U600. (INPUT) C ITAU = THE NUMBER OF HOURS AHEAD TO FIND A VARIABLE. C THIS DOES NOT APPLY TO ALL SUBROUTINES. (INPUT) C NDATE = THE DATE/TIME FOR WHICH VARIABLE IS NEEDED. (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. (CHARACTER*8) C (INPUT) C ISDATA(K) = WORK ARRAY (K=1,ND1). (INTERNAL) C XDATA(K) = DATA TO RETURN (K=1,NSTA). (OUTPUT) C NOTE THAT THIS ARRAY IS DOUBLY DIMENSIONED IN THE C DRIVER AS (ND1,ND2) IN ORDER TO HANDLE CATEGORICAL C FORECASTS. IN SUBROUTINE OPTX, THIS ARRAY IS C DIMENSIONED AS ND1; HOWEVER, THE PRACTICAL EFFECT IS C TO RESERVE ND1*ND2 ADDRESSES FOR AVAILABLE SPACE. C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH. C (INPUT) C NCAT = A CATEGORY NUMBER FOR THIS VARIABLE ID( ). C 0 = THIS VARIABLE IS IN A SERIES, NOT THE FIRST. C M = THIS VARIABLE IS THE FIRST OF A SERIES OF C M VARIABLES. C THIS IS USED IN U710 AND WILL NOT HAVE MEANING C FOR MOST USES. (INPUT) C NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT WITH. C (INPUT) C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTEGER C VARIABLE (L=1,L3264W) (K=1,NSTA). C NOTE THAT THIS REQUIRES TWO 32-BIT WORDS TO HOLD C THE DESCRIPTION BUT ONLY ONE 64-BIT WORD. C NEEDED IN CONST FOR ARGUMENT TO RDTDLM. C EQUIVALENCED TO CCALLD( ). C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). EQUIVALENCED C TO ICALLD( , ). (INTERNAL) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C WORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), WORK( ), DATA( ), AND C CALLD( ), AND SECOND DIMENSION OF ICALLD( , ). C (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). (INPUT) 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 CHARACTERISTICS C OF THIS GRID. C L=11 --THE NUMBER OF THE VARIABLE IN THE SORTED C LIST IN ID( ,N) (N=1,NPRED) FOR WHICH THIS C VARIABLE IS NEEDED, WHEN IT IS NEEDED ONLY C ONCE FROM LSTORE( , ). WHEN IT IS NEEDED C MORE THAN ONCE, THE VALUE IS SET = 7777. C L=12 --USED INITIALLY IN ESTABLISHING MSTORE( , ). C LATER USED AS A WAY OF DETERMINING WHETHER C TO KEEP THIS VARIABLE. C ND9 = THE SECOND DIMENSION OF LSTORE( , ). (INPUT) C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , ) THAT C HAVE BEEN USED IN THIS RUN. (INPUT/OUTPUT) C CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA IDENTIFIED IN C LSTORE( , ) (J=1,ND10). WHEN CORE( ) IS FULL C DATA ARE STORED ON DISK. (INPUT/OUTPUT) C ND10 = DIMENSION OF CORE( ). (INPUT) C LASTL = THE LAST LOCATION IN CORE( ) USED. THIS MAY BE C MODIFIED, ALONG WITH ITEMS, IF COMPACTION IS C DONE BY GCPAC. INITIALIZED TO ZERO ON FIRST C ENTRY TO GSTORE. MUST BE CARRIED WHENEVER C GSTORE IS TO BE CALLED. (INPUT-OUTPUT) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK. INITIALIZED C TO ZERO ON FIRST ENTRY TO GSTORE. MUST BE CARRIED C WHENEVER GSTORE IS TO BE CALLED. (INPUT-OUTPUT) C NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM C DISK FILE. (INPUT) C NSTORE = RUNNING COUNT OF NUMBER OF TIMES DATA ARE STORED BY C GSTORE. GFETCH KEEPS TRACK OF THIS AND RETURNS C THE VALUE. (OUTPUT) C NFETCH = THE NUMBER OF TIMES GFETCH HAS BEEN ENTERED. GFETCH C KEEPS TRACK OF THIS AND RETURNS THE VALUE. C (OUTPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3). (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,22+). (INTERNAL) C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). (INTERNAL) C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). (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 USED C (EITHER 32 OR 64). (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C CALCULATED BY PARAMETER, BASED ON L3464B. (INPUT) C ISTAB = USUALLY ZERO, BUT SET TO ONE IN CERTAIN C SUBROUTINES. (OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 99 = VARIABLE NOT DEFINED IN OPTX. C SEE CALLED ROUTINES FOR OTHER VALUES. C (INTERNAL-OUTPUT) C ISTAV = 1 WHEN THE DATA RETURNED ARE STATION DATA. C 0 WHEN THE DATA RETURNED ARE GRID DATA OR DATA C ARE NOT AVAILABLE FOR RETURN. RETURNED C FROM SOME COMPUTATIONAL ROUTINES THAT CAN C BE USED IN U201. NOT NEEDED IN OPTX, SINCE C ALL DATA ARE STATION ORIENTED. (INTERNAL) C C NONSYSTEM SUBROUTINES USED C TIMEPV, VERTX, DIFFV, DIRFUV, APPTMP, WNDCHL, C TMPCMP, MAXTEST, MRFTEST, KWHTOJ, TRUNCP, NMLPRB, C MPSKTS, KTSMPS, FTOKEL, DPDPRS, TEMPAV, SUNFCT, C SUNAMT, SOLENG, SOLAMT, DIRCALM, ZRONEG, ADJSPD, NORWND, C POPDIF, FORIER, OPFCST, CONST, CATGR1, PROBXCON, C MONPRB, CMPPRB, FCSTDF, KTOF, CONVQPF, MERGID, RHUMID, C MAXWND, PCT2DC, GUSTDEC, EXVALU, CM2DSC, EXPVAL, ADJEXPQPF, C DC2PCT, GUSTPST, CATMOD, DBTAIL, CIGBLOTDSC, IFRCAT C CMBWNDG, PCNVPP, CNVPOT C CHARACTER*8 CCALL(ND1,6) CHARACTER*8 CCALLD(ND5) CHARACTER*60 RACESS(5) C DIMENSION ISDATA(ND1),XDATA(ND1) DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION ICALLD(L3264W,ND5),IPACK(ND5),IWORK(ND5),DATA(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION KFILRA(5) C IER=0 ISTAB=0 C ISTAB IS RETURNED AS 0 (NON BINARY) UNLESS SET OTHERWISE. ISTAV=1 C ISTAV IS RETURNED AS 1 (VECTOR DATA) UNLESS SET OTHERWISE. C MOST SUBROUTINES SET ISTAV. C D WRITE(KFILDO,100)(ID(J),J=1,4),(IDPARS(J),J=1,15), D 1 L3264W,NSTA,IER D100 FORMAT(' IN OPTX, ID, IDPARS, L3264W, NSTA, IER',/, D 1 ' ',4I10,15I5,3I4) C C ROUTINE TIMEPV CALCULATES A TIME DIFFERENCE C ACCORDING TO IDPARS(10). C IF(IDPARS(10).NE.0)THEN CALL TIMEPV(KFILDO,KFIL10, 1 ID,IDPARS,JD,ITAU,NDATE,MDATE,XDATA,ND1,NSTA, 2 IPACK,WORK,DATA,ND5, 3 LSTORE,ND9,LITEMS,CORE,ND10, 4 NBLOCK,NFETCH, 5 IS0,IS1,IS2,IS4,ND7, 6 ISTAV,L3264B,IER) C C ROUTINE VERTX CAN PERFORM BASIC VERTICAL PROCESSING C ACCORDING TO IDPARS(5). C ELSEIF(IDPARS(5).NE.0)THEN CALL VERTX(KFILDO,KFIL10, 1 ID,IDPARS,JD,ITAU,MDATE,XDATA,ND1,NSTA, 2 IPACK,IWORK,DATA,ND5, 3 LSTORE,ND9,LITEMS,CORE,ND10, 4 NBLOCK,NFETCH, 5 IS0,IS1,IS2,IS4,ND7, 6 ISTAV,L3264B,IER) C C LOOK FOR DIFFERENCE OF TWO VARIABLES DENOTED BY C IDPARS(1) = X8X OR X9X. C ELSEIF((IDPARS(1)/10)-((IDPARS(1)/100)*10).GE.8)THEN CALL DIFFV(KFILDO,KFIL10, 1 ID,IDPARS,JD,ITAU,NDATE,MDATE,XDATA,ND1,NSTA, 2 IPACK,WORK,DATA,ND5, 3 LSTORE,ND9,LITEMS,CORE,ND10, 4 NBLOCK,NFETCH, 5 IS0,IS1,IS2,IS4,ND7, 6 ISTAV,L3264B,IER) C C ROUTINE CIGCAT COMPUTES CEILING HEIGHT FROM PROBABILITIES C IN 10 BINS C C*** ELSEIF(IDPARS(1).EQ.208.AND.IDPARS(2).EQ.051)THEN C*** CALL CIGCAT (KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, C*** 1 ID,IDPARS,JD,ITAU, C*** 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, C*** 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, C*** 4 LSTORE,ND9,LITEMS,CORE,ND10, C*** 5 NBLOK,NFETCH, C*** 6 IS0,IS1,IS2,IS4,ND7, C*** 7 L3264B,L3264W,ISTAB,IER) C C ROUTINE DPCAMT COMPUTES NORMALIZED CLOUD LAYER AMOUNT C PROBABILITIES IN 6 DISCRETE CATEGORIES FROM 6 CUMULATIVE C PROBABILITIES FROM U700. C C ELSEIF(IDPARS(1).EQ.208.AND.IDPARS(2).EQ.372)THEN C CALL DPCAMT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, C 1 ID,IDPARS,JD,ITAU, C 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, C 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, C 4 LSTORE,ND9,LITEMS,CORE,ND10, C 5 NBLOK,NFETCH, C 6 IS0,IS1,IS2,IS4,ND7, C 7 L3264B,L3264W,ISTAB,IER) C IF(IER.EQ.191)GO TO 300 C THE SUM OF THE PROBABILITIES IN CBNPRB IS QUESTIONABLE C THIS GIVES A DIRECT RETURN SO U710 CAN COUNT THE ERRORS. C C ROUTINE DIRFUV COMPUTES WIND DIRECTION FROM U AND V. C ELSEIF((IDPARS(1).EQ.004.AND.IDPARS(2).EQ.200).OR. 1 (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.201).OR. 2 (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.202).OR. 3 (IDPARS(1).EQ.704.AND.IDPARS(2).EQ.200).OR. 4 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.200).OR. 5 (IDPARS(1).EQ.224.AND.IDPARS(2).EQ.200))THEN CALL DIRFUV(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE APPTMP COMPUTES THE APPARENT TEMPERATURE GIVEN TEMP. C AND DEW POINT. C ELSEIF(IDPARS(1).EQ.202.AND.IDPARS(2).EQ.030)THEN CALL APPTMP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE WNDCHL COMPUTES THE WIND CHILL GIVEN TEMP. C AND WIND SPEED. C ELSEIF(IDPARS(1).EQ.202.AND.IDPARS(2).EQ.040)THEN CALL WNDCHL(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE TMPCMP MAKES SURE THAT THE TEMPERATURE AT THE C PROJECTION HOUR EITHER EQUAL OR LESS THAN THE DEW POINT C TEMPERATURE AT THAT CORRESPONDING PROJECTION HOUR. C IF THE DEW POINT IS GREATER THAN THE TEMPERATURE, C BOTH VALUES ARE AVERAGED FOR THAT PROJECTION TIME C AND TAKE THE VALUE OF THE AVERAGE. C ELSEIF((IDPARS(1).EQ.202.AND.IDPARS(2).EQ.020).OR. 1 (IDPARS(1).EQ.203.AND.IDPARS(2).EQ.020))THEN CALL TMPCMP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE MAXMNFT FITS A CURVE TO TEMPERATURES AND C RETURNS AN ESTIMATE OF THE MAX OR MIN OF TEMPERATURE. C C ELSEIF(IDPARS(1).EQ.202.AND.((IDPARS(2).EQ.106).OR. C 1 (IDPARS(2).EQ.206).OR.(IDPARS(2).EQ.126).OR. C 2 (IDPARS(2).EQ.226).OR.(IDPARS(2).EQ.236).OR. C 3 (IDPARS(2).EQ.246).OR.(IDPARS(2).EQ.116).OR. C 4 (IDPARS(2).EQ.136).OR.(IDPARS(2).EQ.146)))THEN C*******THE ABOVE TEST IS TEMPORARY. D WRITE(KFILDO,1000) IDPARS(1),IDPARS(2) D1000 FORMAT(/' IN OPTX ONE--IDPARS(1),IDPARS(2)',2I4) C C CALL MXMNFT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, C 1 ID,IDPARS,JD,ITAU, C 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, C 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, C 4 LSTORE,ND9,LITEMS,CORE,ND10, C 5 NBLOK,NFETCH, C 6 IS0,IS1,IS2,IS4,ND7, C 7 L3264B,L3264W,ISTAB,IER) D WRITE(KFILDO,1001)IDPARS(1),IDPARS(2) D1001 FORMAT(/' IN OPTX TWO--IDPARS(1),IDPARS(2)',2I4) C C ROUTINE MAXTEST ENSURES THAT THE MAXIMUM AND MINIMUM C TEMPERATURES ARE ALWAYS EITHER EQUAL TO OR LESS THAN C THE 3-HOUR FORECAST TEMPERATURES. C ELSEIF(IDPARS(1).EQ.202.AND.((IDPARS(2).EQ.120).OR. 1 (IDPARS(2).EQ.220)))THEN CALL MAXTEST(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 SUBROUTINE MRFTEST ENSURES THAT THE CURRENT MAXIMUM C (MINIMUM) TEMPERATURE IS CONSISTENT WITH THE PREVIOUS C MINIMUM (MAXIMUM) AND FOLLOWING MINIMUM (MAXIMUM) C TEMPERATURES. C ELSEIF(IDPARS(1).EQ.202.AND.((IDPARS(2).EQ.140).OR. 1 (IDPARS(2).EQ.145).OR.(IDPARS(2).EQ.240).OR. 2 (IDPARS(2).EQ.245)))THEN CALL MRFTEST(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 MERGID WILL MERGE MAX/MIN TEMPERATURES FOR CO-OPS WITH C MESO-WEST SITES. IT WILL ALSO CHANGE THE METAR IDS C FROM 202X40 TO 202X50. THIS IS FOR THE GRIDDED MOS WORK C SO WE CAN MERGE OUR STATION FORECASTS TOGETHER INTO 1 FILE. C ELSEIF(((IDPARS(1).EQ.202).AND.(IDPARS(2).EQ.150)).OR. 1 (IDPARS(1).EQ.202).AND.(IDPARS(2).EQ.250)) THEN CALL MERGIDS(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 SUBROUTINE KTOF CONVERTS DEGREES KELVIN TO FAHRENHEIT. C ELSEIF((IDPARS(1).EQ.002.AND.(IDPARS(2).EQ.301.OR. 1 IDPARS(2).EQ.311.OR. 2 IDPARS(2).EQ.321.OR. 3 IDPARS(2).EQ.351.OR. 4 IDPARS(2).EQ.361)).OR. 5 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.301).OR. 6 (IDPARS(1).EQ.202.AND.(IDPARS(2).EQ.050.OR. 7 IDPARS(2).EQ.130.OR. 8 IDPARS(2).EQ.230)).OR. 9 (IDPARS(1).EQ.203.AND.IDPARS(2).EQ.030)) THEN CALL KTOF(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 SUBROUTINE RHUMID COMPUTES RH USING TEMP AND DEWPT C ELSEIF(IDPARS(1).EQ.203.AND.IDPARS(2).EQ.060)THEN CALL RHUMID(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE EXVALU COMPUTES EXPECTED VALUE OF PRECIPIATATION C FROM PROBABILISTIC QPF. NOTE: COMMENTED OUT 2/2007 WHEN C EXPVAL WAS ADDED. C C ELSEIF((IDPARS(1).EQ.203).AND.((IDPARS(2).EQ.260).OR. C 1 (IDPARS(2).EQ.360))) THEN C CALL EXVALU(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, C 1 ID,IDPARS,JD,ITAU, C 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, C 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, C 4 LSTORE,ND9,LITEMS,CORE,ND10, C 5 NBLOCK,NFETCH, C 6 IS0,IS1,IS2,IS4,ND7, C 7 L3264B,L3264W,IER) C C ROUTINE EXPVAL COMPUTES EXPECTED VALUE OF PROBABILISTIC C FORECASTS. C ELSEIF(((IDPARS(1).EQ.203).AND.((IDPARS(2).EQ.260).OR. 1 (IDPARS(2).EQ.360))).OR. 2 ((IDPARS(1).EQ.208).AND.(IDPARS(2).EQ.385))) THEN CALL EXPVAL(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE ADJEXP ADJUSTS EXPECTED VALUE TO BE CONSISTENT C WITH CATEGORICAL FORECASTS C **NOTE** COMMENTED OUT, QPF USING ADJEXPQPF, CLOUDS C NOT CURRENTLY USING EXPECTED VALUES AT ALL C CCC ELSEIF(((IDPARS(1).EQ.208).AND.(IDPARS(2).EQ.395)).OR. CCC ((IDPARS(1).EQ.203).AND.((IDPARS(2).EQ.270).OR. CCC 1 (IDPARS(2).EQ.370))))THEN CCC CALL ADJEXP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, CCC 1 ID,IDPARS,JD,ITAU, CCC 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, CCC 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, CCC 4 LSTORE,ND9,LITEMS,CORE,ND10, CCC 5 NBLOCK,NFETCH, CCC 6 IS0,IS1,IS2,IS4,ND7, CCC 7 L3264B,L3264W,IER) C C ROUTINE ADJEXPQPF ADJUSTS EXPECTED VALUE TO BE CONSISTENT C WITH CATEGORICAL FORECASTS (QPF ONLY) C ELSEIF((IDPARS(1).EQ.203).AND.((IDPARS(2).EQ.270).OR. 1 (IDPARS(2).EQ.370)))THEN CALL ADJEXPQPF(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 CONVERT PERCENT TO DECIMAL C ELSEIF(IDPARS(1).EQ.203.AND.IDPARS(2).EQ.520) THEN CALL PCT2DC(KFILDO,KFIL10, 1 ID,IDPARS,JD,ITAU,MDATE,XDATA,ND1,NSTA, 2 IPACK,IWORK,ND5, 3 LSTORE,ND9,LITEMS,CORE,ND10, 4 NBLOCK,NFETCH, 5 IS0,IS1,IS2,IS4,ND7, 6 ISTAV,L3264B,IER) C C ROUTINE DC2PCT CONVERT PROBABILTY FORECASTS C TO PRECENT. C ELSEIF((IDPARS(1).EQ.207.AND.IDPARS(2).EQ.514).OR. ! ltg prb 1 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.564).OR. ! cnv prb 2 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.614).OR. ! ltg prb 3 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.664).OR. ! cnv prb 4 (IDPARS(1).EQ.203.AND.IDPARS(2).EQ.615).OR. ! 1-h pop 5 (IDPARS(1).EQ.203.AND.IDPARS(2).EQ.235).OR. ! 6-h pop 6 (IDPARS(1).EQ.203.AND.IDPARS(2).EQ.335))THEN ! 12-h pop CALL DC2PCT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ADJUV SETS THE U- AND V-WIND COMPONENTS TO ZERO IF THE C WIND SPEED HAS BEEN SET TO 0. THIS IS USED AFTER ZRONEG C HAS SET A NEGATIVE WIND SPEED TO ZERO C ELSEIF((IDPARS(1).EQ.204.AND.IDPARS(2).EQ.020).OR. 1 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.120))THEN CALL ADJUV(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 POST PROCESS LMP WIND GUST FORECAST. C ELSEIF((IDPARS(1).EQ.204.AND.IDPARS(2).EQ.355))THEN CALL GUSTPST(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE GUSTDEC DETERMINES IF A MOS WIND GUST FORECAST C IS TO BE MADE. C ELSEIF(IDPARS(1).EQ.204.AND.IDPARS(2).EQ.375) THEN CALL GUSTDEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE CMBWNDG COMBINES WIND GUSTS AND SPEEDS FOR C INPUT TO THE GRIDDED MOS ANALYSIS OF GUSTS. C ELSEIF(IDPARS(1).EQ.204.AND.IDPARS(2).EQ.385) THEN CALL CMBWNDG(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 C ROUTINE MAXWND DETERMINES THE HIGHEST WIND SPEED DURING C A 12-HR PERIOD BY LOOKING AT THE 3-H WINDS DURING THAT C SAME PERIOD. THIS IS FOR THE EXTENDED-RANGE GFS. C ELSEIF(IDPARS(1).EQ.204.AND.IDPARS(2).EQ.530)THEN CALL MAXWND(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE KWHTOJ CONVERTS ENERGY FROM KWH TO JOULES. C ELSEIF(IDPARS(1).EQ.209.AND.(IDPARS(2).EQ.304))THEN CALL KWHTOJ(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE TRUNCP SETS NEGATIVE PROBABILITY VALUES LESS THAN C ZERO EQUAL TO ZERO AND PROBABILITY VALUES GRATER THAN 1 C BACK TO 1. COMMENTED OUT 'TRUNCP' BECAUSE 'MONPRB', AT THIS C POINT IN TIME, PERFORMES THE SAME FUNCTION. C C ELSEIF((IDPARS(1).EQ.208.AND.IDPARS(2).EQ.330).OR. C 1 (IDPARS(1).EQ.203.AND.((IDPARS(2).EQ.230).OR. C 2 (IDPARS(2).EQ.330).OR. C 3 (IDPARS(2).EQ.430))) C 4 .AND.(IDPARS(3).NE.0))THEN C CALL TRUNCP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, C 1 ID,IDPARS,JD,ITAU, C 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NCAT,NSTA, C 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, C 4 LSTORE,ND9,LITEMS,CORE,ND10, C 5 NBLOCK,NFETCH, C 6 IS0,IS1,IS2,IS4,ND7, C 7 L3264B,L3264W,ISTAB,IER) C C ROUTINE NMLPRB SETS NEGATIVE VALUES EQUAL TO ZERO AND SUMS-UP C ALL POSITIVE VALUES. EACH POSITIVE VALUE IS THEN DIVIDED BY C THE TOTAL SUM SO THAT WHEN ADDED TOGETHER EQUAL 1. C ELSEIF((IDPARS(1).EQ.208.AND.((IDPARS(2).EQ.050).OR. 1 (IDPARS(2).EQ.350).OR. 2 (IDPARS(2).EQ.545).OR. 3 (IDPARS(2).EQ.555).OR. 4 (IDPARS(2).EQ.645).OR. 5 (IDPARS(2).EQ.665).OR. 6 (IDPARS(2).EQ.290).OR. 7 (IDPARS(2).EQ.390)).AND. 8 (IDPARS(3).EQ.3)).OR. 9 ((IDPARS(1).EQ.204).AND.(IDPARS(2).EQ.425).AND. A (IDPARS(3).EQ.3)))THEN CALL NMLPRB(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 ELSEIF(IDPARS(1).EQ.203.AND.(IDPARS(2).EQ.610.OR. 1 IDPARS(2).EQ.612)) THEN C IF(IDPARS(4).EQ.15.OR.IDPARS(4).EQ.25) THEN ! LAMP POP C C LPOPPP POST-PROCESSES OVERLAPPING-REGION LAMP POP C PROBABILITIES...USES REGIONAL-WEIGHTING METHOD. C CALL LPOPPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH,LASTL,LASTD, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,ISTAB,L3264B,L3264W,IER) C ELSEIF(IDPARS(4).EQ.35.OR.IDPARS(4).EQ.45) THEN ! MELD POP C C MPOPPP POST-PROCESSES OVERLAPPING-REGION MELD POP C PROBABILITIES...USES REGIONAL-WEIGHTING METHOD. C CALL MPOPPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH,LASTL,LASTD, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,ISTAB,L3264B,L3264W,IER) C ELSE C C LPQPFPP POST-PROCESSES OVERLAPPING-REGION MOS POP C PROBABILITIES...USES REGIONAL-WEIGHTING METHOD. C CALL LPQPFPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH,LASTL,LASTD, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,ISTAB,L3264B,L3264W,IER) ENDIF C C PCNVPP POST-PROCESSES OVERLAPPING-REGION LAMP CONVEC AND C NEW LTG PROBABILITIES...USES REGIONAL-WEIGHTING METHOD, C WHICH IS ALSO USED IN HRQPF. THIS OPERATES ON 2-H PROBS. C ELSEIF((IDPARS(1).EQ.207.AND.IDPARS(2).EQ.510).OR. ! ltg prb 1 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.560)) THEN ! cnv prb C CALL PCNVPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH,LASTL,LASTD, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,ISTAB,L3264B,L3264W,IER) C C PCNVPP1H POST-PROCESSES OVERLAPPING-REGION LAMP CONVEC AND C NEW LTG PROBABILITIES...USES REGIONAL-WEIGHTING METHOD, C WHICH IS ALSO USED IN HRQPF. THIS OPERATES ON 1-H PROBS. C ELSEIF((IDPARS(1).EQ.207.AND.IDPARS(2).EQ.610).OR. ! ltg prb 1 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.660)) THEN ! cnv prb C CALL PCNVPP1H(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH,LASTL,LASTD, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,ISTAB,L3264B,L3264W,IER) C C COMPUTE LAMP CONVEC OR LTG POTENTIAL PRODUCT (CNVPOT), C EITHER 1-H OR 2-H PRODUCTS. C ELSEIF((IDPARS(1).EQ.207.AND.IDPARS(2).EQ.501).OR. ! ltg cat 1 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.511).OR. ! ltg pot 2 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.561).OR. ! cnv pot 3 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.611).OR. ! ltg pot 4 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.661)) THEN ! cnv pot C CALL CNVPOT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 PROBXCON CALCULATES THE 12 AND 24 HOUR UNCONDITIONAL PROBABILITIES C FOR PRECIP, SEVERE WEATHER AND SNOWFALL. PREVIOUSLY CALLED POPXCON. C ELSEIF(((IDPARS(1).EQ.203).AND.((IDPARS(2).EQ.210).OR. 1 (IDPARS(2).EQ.310).OR. 2 (IDPARS(2).EQ.410)).AND. 3 (IDPARS(3).EQ.1)).OR. 4 ((IDPARS(1).EQ.207).AND.((IDPARS(2).EQ.270).OR. 5 (IDPARS(2).EQ.380).OR. 6 (IDPARS(2).EQ.480)).AND. 7 (IDPARS(3).EQ.1)).OR. 8 ((IDPARS(1).EQ.208).AND.((IDPARS(2).EQ.455).OR. 9 (IDPARS(2).EQ.460)))) THEN CALL PROBXCON(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 MONPRB ENSURES THAT A SET OF PROBABILITIES BEHAVES IN C MONOTONICALLY. AT THIS TIME, IT ALSO SETS NEGATIVE C PROBABILITIES TO 0, AND THOSE GREATER THAN 1 TO 1. C (NOTE: THE REASON THERE IS A CHECK ON IDPARS(3) IS C BECAUSE ONCE UPON A TIME, PROBABILITIES AND BEST CAT C FORECASTS HAD THE SAME CCCFFF'S. NOT SO ANYMORE) C ELSEIF((((IDPARS(1).EQ.203).OR.(IDPARS(1).EQ.207)).AND. 1 ((IDPARS(2).EQ.120).OR. 2 (IDPARS(2).EQ.220).OR. 3 (IDPARS(2).EQ.320).OR. 4 (IDPARS(2).EQ.420).OR. 5 (IDPARS(2).EQ.450)).AND. 6 ((IDPARS(3).EQ.1).OR. 7 (IDPARS(3).EQ.2))).OR. 8 ((IDPARS(1).EQ.204).AND.(IDPARS(2).EQ.365).AND. 9 (IDPARS(3).EQ.1)).OR. A ((IDPARS(1).EQ.207).AND.((IDPARS(2).EQ.165).OR. B (IDPARS(2).EQ.265).OR. C (IDPARS(2).EQ.365).OR. D (IDPARS(2).EQ.465)).AND. E ((IDPARS(3).EQ.1).OR. F (IDPARS(3).EQ.2))).OR. G ((IDPARS(1).EQ.208).AND.((IDPARS(2).EQ.070).OR. H (IDPARS(2).EQ.120).OR. I (IDPARS(2).EQ.130).OR. J (IDPARS(2).EQ.380).OR. K (IDPARS(2).EQ.465).OR. L (IDPARS(2).EQ.620).OR. M (IDPARS(2).EQ.630)).AND. N ((IDPARS(3).EQ.1).OR. O (IDPARS(3).EQ.2))))THEN CALL MONPRB(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 DBTAIL ENSURE'S MONOTONIC BEHAVIOR FOR A SET OF CUMULATIVE C PROBABILITIES CUMULATIVE FROM BELOW GOING FROM C THE RARE EVENT TO MORE COMMON EVENTS TO RARE EVENTS C WRITTEN FOR LAMP CONDITIONAL CIG. C ELSEIF((IDPARS(1).EQ.208).AND.((IDPARS(2).EQ.055).OR. 1 (IDPARS(2).EQ.155)))THEN CALL DBTAIL(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 CONVERSION AND POST PROCESSING OF CEILING HEIGHT C CONDITIONAL OR UNCONDITIONAL) FROM CUMULATIVE (CUMULATIVE C FROM BELOW) TO DISCRETE. C A. CONDITIONAL CEILING HEIGHT POST PROCESSED VIA DBTAIL AND C ARE THEN CONVERTED TO DISCRETE IN CM2DSC. C B. UNCONDITIONAL CEILING HEIGHT POST PROCESSED VIA MONPRB C AND ARE THEN CONVERTED TO DISCRETE IN CM2DSC. C C. OPAQUE SKY COVER POST PROCESSED VIA MONPRB C AND ARE THEN CONVERTED TO DISCRETE IN CM2DSC. C ELSEIF((IDPARS(1).EQ.208).AND.((IDPARS(2).EQ.059).OR. 1 (IDPARS(2).EQ.074).OR. 2 (IDPARS(2).EQ.384)))THEN CALL CM2DSC(KFILDO,KFIL10,IP12,KFILRA, 1 RACESS,NUMRA,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 C ENSURES MELD 6-HR (12-HR) PQPF FORECASTS ARE C CONSISTENT WITH THE 1-HR (6-HR) PQPF WITHIN C THE PERIOD. C ELSEIF((IDPARS(4).EQ.35.OR.IDPARS(4).EQ.45).AND. 1 IDPARS(1).EQ.203.AND.(IDPARS(2).EQ.230.OR. 2 IDPARS(2).EQ.330))THEN CALL CNCHKPQPF(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 C ENSURES THAT 6 OR 12 HR PROBABILITY FORECASTS C ARE CONSISTENT WITH THE 12 OR 24 HR FORECAST c PROBABILITIES C ELSEIF(((IDPARS(1).EQ.207).AND.((IDPARS(2).EQ.230).OR. 1 (IDPARS(2).EQ.330).OR. 2 (IDPARS(2).EQ.430))).OR. 3 ((IDPARS(1).EQ.207).AND.((IDPARS(2).EQ.275).OR. 4 (IDPARS(2).EQ.375).OR. 5 (IDPARS(2).EQ.475))).OR. 6 ((IDPARS(1).EQ.203).AND.((IDPARS(2).EQ.330).OR. A (IDPARS(2).EQ.430))).AND. B (IDPARS(3).EQ.1)) THEN CALL CMPPRB(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 ROUTINE CONVQPF CONVERTS NGM MOS QPF VALUES INTO A FORM C COMPATIBLE WITH THE NEWER AVN/MRF/ETA MOS QPF. C ELSEIF(IDPARS(1).EQ.203.AND.(IDPARS(2).EQ.219.OR. 1 (IDPARS(2).EQ.229)))THEN CALL CONVQPF(KFILDO,KFIL10, 1 ID,IDPARS,JD,ITAU, 2 MDATE,XDATA,ND1,NSTA, 3 IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,L3264B,IER) C C COMPUTE BEST CATEGORY FROM PROBABILITY FORECASTS C AND THRESHOLDS. (WITH THE OLD CATEGORICAL ID C SCHEME, WE USED TO ALSO CHECK THAT IDPARS(3)=0) C ELSEIF((IDPARS(1).EQ.208.AND.((IDPARS(2).EQ.051).OR. 1 (IDPARS(2).EQ.056).OR. 2 (IDPARS(2).EQ.071).OR. 3 (IDPARS(2).EQ.121).OR. 4 (IDPARS(2).EQ.131).OR. 5 (IDPARS(2).EQ.156).OR. 6 (IDPARS(2).EQ.291).OR. 7 (IDPARS(2).EQ.351).OR. 8 (IDPARS(2).EQ.381).OR. 9 (IDPARS(2).EQ.391).OR. A (IDPARS(2).EQ.461).OR. B (IDPARS(2).EQ.546).OR. C (IDPARS(2).EQ.556).OR. D (IDPARS(2).EQ.621).OR. E (IDPARS(2).EQ.646).OR. F (IDPARS(2).EQ.666))).OR. G (IDPARS(1).EQ.203.AND.((IDPARS(2).EQ.221).OR. H (IDPARS(2).EQ.321).OR. I (IDPARS(2).EQ.331).OR. J (IDPARS(2).EQ.421).OR. K (IDPARS(2).EQ.431).OR. L (IDPARS(2).EQ.621))).OR. L (IDPARS(1).EQ.204.AND.((IDPARS(2).EQ.366)))) THEN CALL CATGR1(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 COMPUTE BEST CATEGORY FROM PROBABILITY FORECASTS C AND THRESHOLDS. CATMLD WAS CREATED FOR MAKING THE DETERMINISTIC C MELD FORECASTS C ELSEIF((ID(1).EQ.208081095).OR.(ID(1).EQ.208161095).OR. 1 (ID(1).EQ.208081035).OR.(ID(1).EQ.208161035))THEN CALL CATMLD(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE MPSKTS CONVERTS M/S TO KTS. C ELSEIF((IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.030.OR. 1 IDPARS(2).EQ.130.OR. 2 IDPARS(2).EQ.230.OR. 3 IDPARS(2).EQ.031.OR. 4 IDPARS(2).EQ.131.OR. 5 IDPARS(2).EQ.231.OR. 6 IDPARS(2).EQ.032.OR. 7 IDPARS(2).EQ.132.OR. 8 IDPARS(2).EQ.232)).OR. 9 (IDPARS(1).EQ.204.AND.(IDPARS(2).EQ.230.OR. A IDPARS(2).EQ.330)))THEN CALL MPSKTS(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE KTSMPS CONVERTS KTS. TO M/S. C ELSEIF(IDPARS(1).EQ.204.AND.(IDPARS(2).EQ.324.OR. 1 IDPARS(2).EQ.329.OR. 2 IDPARS(2).EQ.014.OR. 3 IDPARS(2).EQ.024.OR. 4 IDPARS(2).EQ.114.OR. 5 IDPARS(2).EQ.124.OR. 6 IDPARS(2).EQ.314.OR. 7 IDPARS(2).EQ.319.OR. 8 IDPARS(2).EQ.339.OR. 9 IDPARS(2).EQ.359.OR. A IDPARS(2).EQ.379.OR. B IDPARS(2).EQ.384.OR. C IDPARS(2).EQ.389.OR. D IDPARS(2).EQ.479.OR. E IDPARS(2).EQ.534))THEN CALL KTSMPS(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE FTOKEL CONVERTS FAHRENHEIT TO KELVIN. C ELSEIF((IDPARS(1).EQ.202.AND.(IDPARS(2).EQ.024.OR. 1 IDPARS(2).EQ.124.OR. 2 IDPARS(2).EQ.144.OR. 3 IDPARS(2).EQ.224.OR. 4 IDPARS(2).EQ.244)).OR. 5 (IDPARS(1).EQ.203.AND.(IDPARS(2).EQ.024)))THEN CALL FTOKEL(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE CATMODT CONVERTS THE YES/NO CATEOGROIES C FOR THE GRIB MESSAGE C ELSEIF((IDPARS(1).EQ.207.AND.IDPARS(2).EQ.502))THEN CALL CATMOD(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 C ROUTINE IFRCAT RETURNS VALUES BETWEEN 1 AND 5 FOR C EACH POSSIBLE FLIGHT CONDITION (VLIFR,LIFR,IFR,MVFR, C AND VFR). C ELSEIF((IDPARS(1).EQ.708.AND.((IDPARS(2).EQ.210).OR. 1 (IDPARS(2).EQ.223))).OR. 2 (IDPARS(1).EQ.208.AND.((IDPARS(2).EQ.211).OR. 3 (IDPARS(2).EQ.223))))THEN CALL IFRCAT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE DPDPRS COMPUTES THE DEW POINT DEPRESSION GIVEN TEMP. C AND DEW POINT. C ELSEIF(IDPARS(1).EQ.203.AND.IDPARS(2).EQ.040)THEN CALL DPDPRS(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE TEMPAV AVERAGES TEMPERATURE OR DEWPOINT AT C THE SAME PROJECTION. C ELSEIF(((IDPARS(1).EQ.202).AND.(IDPARS(2).EQ.010)).OR. 1 ((IDPARS(1).EQ.203).AND.(IDPARS(2).EQ.010)))THEN CALL TEMPAV(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE SUNFCT COMPUTES THE PERCENTAGE (FRACTION) OF SUNSHINE. C NOTE THAT THE VALUES RANGE BETWEEN 0.0-1.0 . C ELSEIF(IDPARS(1).EQ.209.AND.IDPARS(2).EQ.300)THEN CALL SUNFCT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 SUBROUTINE 'SUNAMT' CALCULATES THE SUNSHINE AMOUNT IN HOURS. C ELSEIF(IDPARS(1).EQ.209.AND.IDPARS(2).EQ.310)THEN CALL SUNAMT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 SUBROUTINE 'SOLENG' CALCULATES THE FRACTION OF SOLAR ENERGY IN DECIMAL C FORM. C ELSEIF(IDPARS(1).EQ.209.AND.IDPARS(2).EQ.200) THEN CALL SOLENG(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 SUBROUTINE 'SOLAMT' CALCULATES THE SOLAR ENERGY AMOUNT IN (KWH/M^2). C ELSEIF(IDPARS(1).EQ.209.AND.IDPARS(2).EQ.210) THEN CALL SOLAMT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ENSURES THAT A WIND LESS THAN ONE KNOT IS IDENTIFIED AS CALM. C ELSEIF((IDPARS(1).EQ.204.AND.IDPARS(2).EQ.220).OR. 1 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.225).OR. 2 (IDPARS(1).EQ.224.AND.IDPARS(2).EQ.225).OR. 3 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.235))THEN CALL DIRCALM(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ENSURES THAT A FORECAST WIND SPEED IS SET TO ZERO, IF THE C RAW WIND SPEED IS NEGATIVE; ALSO CHECKS THE WIND DIRECTION C FOR A MISSING VALUE (WHICH WILL OCCUR WITH A VALID WIND C SPEED ONLY WHEN THE U AND V COMPONENTS EQUAL 0) AND THEN SETS C THE WIND SPEED TO ZERO. ESSENTIALLY, THIS SUBROUTINE ENSURES C THAT THE WIND SPEED WILL BE ZERO, IF THE WIND IS NEGATIVE OR C IF THE WIND DIRECTION INDICATES THAT THE WIND IS CALM. C ELSEIF((IDPARS(1).EQ.204.AND.IDPARS(2).EQ.320).OR. 1 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.325).OR. 2 (IDPARS(1).EQ.224.AND.IDPARS(2).EQ.325).OR. 3 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.475))THEN CALL ZRONEG(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 DUE TO THE FACT THAT NOT ALL MOS SITES OBSERVE WIND SPEED AT C A HEIGHT OF 10M THIS ROUTINE ADJUSTS THE FORECAST WIND SPEED C TO BE CONSISTENT WITH THAT OF A WIND SPEED AT 10M. THE POWER C LAW PROFILE IS USED IN THE ADJUSTMENT, ASSUMING NEAR-NEUTRAL C CONDITIONS. C ELSEIF((IDPARS(1).EQ.204.AND.IDPARS(2).EQ.335))THEN CALL ADJSPD(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE TO SET WIND DIRECTION GE 345 DEG TO C 360 - 345 FOR DIRECTION CONTINGENCY TABLE. C ELSEIF((IDPARS(1).EQ.004.AND.IDPARS(2).EQ.203).OR. 1 (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.204).OR. 2 (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.205).OR. 3 (IDPARS(1).EQ.704.AND.IDPARS(2).EQ.203).OR. 4 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.203).OR. 5 (IDPARS(1).EQ.204.AND.IDPARS(2).EQ.205))THEN CALL NORWND(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 LOOK FOR DIFFERENCE COMPUTATION FOR DAYTIME MAX TEMP, C NIGHTTIME MIN TEMP, 12-H POP, WIND SPEED, OR WIND C DIRECTION. C ELSEIF((IDPARS(1).GE.202.AND.IDPARS(1).LE.204).AND. 1 (IDPARS(2).EQ.801.OR.IDPARS(2).EQ.811.OR. 2 IDPARS(2).EQ.805.OR.IDPARS(2).EQ.905.OR. 3 IDPARS(2).EQ.901.OR.IDPARS(2).EQ.911)) THEN CALL FCSTDF(KFILDO,KFIL10, 1 ID,IDPARS,JD,ITAU,MDATE,XDATA,ND1,NSTA, 2 IPACK,IWORK,DATA,ND5, 3 LSTORE,ND9,LITEMS,CORE,ND10, 4 NBLOCK,NFETCH, 5 IS0,IS1,IS2,IS4,ND7, 6 ISTAV,L3264B,IER) C C LOOK FOR MAPPING NEW PROBABILITIES INTO THE C OLD ID SCHEME. C ELSEIF(IDPARS(1).EQ.208.AND. 1 (IDPARS(2).EQ.040.OR.IDPARS(2).EQ.340))THEN CALL FIXPRB(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 ROUTINE FIXCAT MAPS THE "NEW" CEILING AND CLOUD C CATEGORICAL VALUES TO THE "OLD" VALUES. C ELSEIF(IDPARS(1).EQ.208.AND.(IDPARS(2).EQ.041.OR. 1 (IDPARS(2).EQ.341)))THEN CALL FIXCAT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 ROUTINE FIXQPFCAT UNIFIES 12H QPF CAT FROM SHORT- AND C EXTENDED-RANGE GFS MOS INTO ONE ID FOR BUFR. C ELSEIF(IDPARS(1).EQ.203.AND.(IDPARS(2).EQ.332)) THEN CALL FIXQPFCAT(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,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 LOOK FOR POP DIFFERENCE COMPUTATION (FOLLOWING WAS ELIMINATED C IN AUGUST 2000 C C ELSEIF(IDPARS(1).EQ.203.AND.(IDPARS(2).EQ.506.OR. C 1 IDPARS(2).EQ.507.OR. C 2 IDPARS(2).EQ.508.OR. C 3 IDPARS(2).EQ.509))THEN C CALL POPDIF(KFILDO,KFIL10, C 1 ID,IDPARS,JD,ITAU,MDATE,XDATA,ND1,NSTA, C 2 IPACK,IWORK,DATA,ND5, C 3 LSTORE,ND9,LITEMS,CORE,ND10, C 4 NBLOCK,NFETCH, C 5 IS0,IS1,IS2,IS4,ND7, C 6 ISTAV,L3264B,IER) C C LOOK FOR COMPUTATION OF SIN AND COS OF DAY OF YEAR. C FORIER RETURNS ISTAV, BUT IT IS NOT USED. NOTE THAT C NDATE (NOT MDATE) IS USED BECAUSE THE TAU IN THE ID C IS USED WITH NDATE TO GET THE DATE/TIME OF THE C DATA WANTED. C ELSEIF(IDPARS(1).EQ.010.AND.IDPARS(2).GE.201. 1 .AND.IDPARS(2).LE.208)THEN CALL FORIER(KFILDO,IDPARS,JD,NDATE, 1 XDATA,NSTA,ISTAV,IER) C ELSE C IER=99 C IER = 99 AT THIS POINT INDICATES THE IDS COULD C NOT BE FOUND. ENDIF C C AT THIS POINT, C IER = 0, GOOD RETURN FROM ONE OF THE ABOVE. C IER = 99, COULD NOT FIND IDS ABOVE. C IER = 120 ENTERED ROUTINE, FOUND DATA, BUT C JUST A STATION MISSING IN DIRECTORY. C (THIS WILL LIKELY NOT OCCUR HERE C BECAUSE THE FINDST IER = 120, C CALLED FROM CONST, IS SET = 0 IN C RETVEC; KEEP THE TEST FOR 120 AS C WELL AS 0 FOR SAFETY.) C IER = SOME OTHER VALUE, FOUND IDS, BUT ERROR C OF SOME SORT. C IF(IER.EQ.0.OR. 1 IER.EQ.120)GO TO 300 C C IF THE ID IS FOR AN OPERATIONAL FORECAST FOR THE C ETA, AVN, OR MRF MODELS (CCC = 2XX AND C DD = 01, 05, 07, 08, OR 09) CALL OPFCST. C IF(IDPARS(1)/100.EQ.2.AND. 1 (IDPARS(4).EQ.1.OR. 2 IDPARS(4).EQ.3.OR. 3 IDPARS(4).EQ.33.OR. 3 IDPARS(4).EQ.63.OR. 4 IDPARS(4).EQ.5.OR. 5 IDPARS(4).EQ.7.OR. 6 IDPARS(4).EQ.8.OR. 7 IDPARS(4).EQ.9))THEN CALL OPFCST(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 IF(IER.EQ.0.OR. 1 IER.EQ.120)GO TO 300 ENDIF C C IF THE ID IS FOR THE OPERATIONAL MELD FORECASTS C CALL OPFCSTID. C IF DD=35 BECOMES STANDARD THIS CALL CAN BE ON IDPARS(4).EQ.35 IF(ID(1).EQ.208071035.OR. 1 ID(1).EQ.208070235.OR. 2 ID(1).EQ.208131035.OR. 3 ID(1).EQ.208130235.OR. 4 ID(1).EQ.203618135.OR. 5 ID(1).EQ.203238135.OR. 6 ID(1).EQ.203338135.OR. 7 ID(1).EQ.208381035.OR. 8 ID(1).EQ.208380235.OR. 9 ID(1).EQ.208056035.OR. A ID(1).EQ.208055235.OR. B ID(1).EQ.208156035.OR. C ID(1).EQ.208155235.OR. D ID(1).EQ.202020035.OR. E ID(1).EQ.203020035.OR. F ID(1).EQ.204010035.OR. G ID(1).EQ.204110035.OR. H ID(1).EQ.204225035.OR. I ID(1).EQ.204325035.OR. J ID(1).EQ.204355035)THEN CALL 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 IF(IER.EQ.0.OR. 1 IER.EQ.120)GO TO 300 ENDIF C C LOOK FOR CONSTANT DATA, TO BE PROVIDED IN THE C MOS-2000 EXTERNAL RANDOM ACCESS FILES. NOTE THAT C NDATE (NOT MDATE) IS USED BECAUSE THE TAU IN THE ID C IS USED WITH NDATE TO GET THE DATE/TIME OF THE C DATA WANTED. NOT USE TO LOOK IF NUMRA = 0, OR IF C AEV FORECASTS OR NGM/AVN MOS GUIDANCE IS BEING SOUGHT. C AEV FORECASTS ARE NEVER CONSTANTS. IT IS IMPORTANT C IN CREATING MSTORE( , ) THAT IER = 99 WHEN IDS C CANNOT BE IDENTIFIED. C IF(NUMRA.GT.0.AND. 1 (IDPARS(4).LT.80.OR.IDPARS(4).GT.82).AND. 2 (IDPARS(4).NE.6).AND.(IDPARS(4).NE.8).AND. 3 ((IDPARS(1).GE.400.AND.IDPARS(1).LE.699).OR. 4 (IDPARS(1).GE.800.AND.IDPARS(1).LE.899).OR. 5 (IDPARS(1).GE.200.AND.IDPARS(1).LE.299)))THEN CALL CONST(KFILDO,KFIL10,IP12, 1 ID,IDPARS,JD,NDATE, 2 KFILRA,RACESS,NUMRA, 3 CCALL,ICALLD,CCALLD, 4 ISDATA,XDATA,ND1,NSTA, 5 IPACK,IWORK,DATA,ND5, 6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL, 7 NBLOCK,LASTD,NSTORE,NFETCH, 8 IS0,IS1,IS2,IS4,ND7, 9 ISTAV,L3264B,L3264W,IER) C IF(IER.EQ.0.OR. 1 IER.EQ.120)GO TO 300 ENDIF C IF(IER.EQ.99)THEN WRITE(KFILDO,198)(ID(J),J=1,4),NDATE 198 FORMAT(/,' ****VRBL NOT IDENTIFIED IN OPTX ', 1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3,' FOR DATE',I11,'.') ELSE WRITE(KFILDO,1980)(ID(J),J=1,4),NDATE 1980 FORMAT(/,' ****VRBL NOT COMPUTED IN OPTX ', 1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3,' FOR DATE',I11,'.') ENDIF C DO 200 K=1,NSTA XDATA(K)=9999. 200 CONTINUE C 300 RETURN END