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 SEPTEMBER 2020 SAMPLATSKY ADDED CNVPOTAK FOR AK CNV/LTG.
C OCTOBER 2022 SHAFER ADDED IDS FOR HRRR/RAP TO CALL TO OPFCST
C AND MELD T/D/W IDS TO CALL TO OPFCSTID
C MARCH 2023 HUANG ADDED IDS FOR 15-MIN C&V 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, CNVPOTAK
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.207.AND.IDPARS(2).EQ.714).OR. ! ltg prb ak
5 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.764).OR. ! cnv prb ak
6 (IDPARS(1).EQ.203.AND.IDPARS(2).EQ.615).OR. ! 1-h pop
7 (IDPARS(1).EQ.203.AND.IDPARS(2).EQ.235).OR. ! 6-h pop
8 (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
ELSEIF(IDPARS(1).EQ.207.AND.IDPARS(2).EQ.710) THEN
C
IF(IDPARS(4).EQ.01.OR.
1 IDPARS(4).EQ.07.OR.IDPARS(4).EQ.08) THEN
C
C POST-PROCESS REGIONAL MOS 1-H TOT LTG PROBS.
C
CALL MOS_1HLTGPP(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.03) THEN
C
C POST-PROCESS REGIONAL RAP MOS 1-H LTG PROBS.
C
CALL RAP_1HLTGPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,
1 NUMRA,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.15.OR.IDPARS(4).EQ.25) THEN
C
C POST-PROCESS REGIONAL BASE LAMP 1-H TOT LTG PROBS.
C
CALL BLMP_1HLTGPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,
1 NUMRA,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
C
C POST-PROCESS REGIONAL MELD 1-H TOT LTG PROBS.
C
CALL MELD_1HLTGPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,
1 NUMRA,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
ELSEIF(IDPARS(1).EQ.207.AND.IDPARS(2).EQ.760) THEN
C
IF(IDPARS(4).EQ.01.OR.
1 IDPARS(4).EQ.07.OR.IDPARS(4).EQ.08)THEN
C
C POST-PROCESS REGIONAL MOS 1-H CONV PROBS.
C
CALL MOS_1HCNVPP(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.03) THEN
C
C POST-PROCESS REGIONAL RAP MOS 1-H CONV PROBS.
C
CALL RAP_1HCNVPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,
1 NUMRA,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.15.OR.IDPARS(4).EQ.25) THEN
C
C POST-PROCESS REGIONAL BASE LAMP 1-H CONV PROBS.
C
CALL BLMP_1HCNVPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,
1 NUMRA,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
C
C POST-PROCESS REGIONAL MELD 1-H CONV PROBS.
C
CALL MELD_1HCNVPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,
1 NUMRA,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 COMPUTE LAMP CONVEC OR LTG POTENTIAL PRODUCT (CNVPOTAK),
C FOR 1-H ALASKA PRODUCTS.
C
ELSEIF((IDPARS(1).EQ.207.AND.IDPARS(2).EQ.711).OR. ! ltg pot
1 (IDPARS(1).EQ.207.AND.IDPARS(2).EQ.761)) THEN ! cnv pot
C
CALL CNVPOTAK(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))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 = 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.
+ ID(1).EQ.208071095.OR.
+ ID(1).EQ.208070295.OR.
2 ID(1).EQ.208131035.OR.
3 ID(1).EQ.208130235.OR.
+ ID(1).EQ.208131095.OR.
+ ID(1).EQ.208130295.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