SUBROUTINE OPTION(KFILDO,KFIL10,NFIRST,
1 ID,IDPARS,THRESH,JD,NDATE,
2 KFILRA,RACESS,NUMRA,ICALL,CCALL,ICALLD,
3 CCALLD,NAME,NELEV,STALAT,STALON,
4 ITIMEZ,ISDATA,SDATA,SDATA1,L1DATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,FD3,FD4,FD5,FD6,FD7,
A FDVERT,FDTIME,FDSINS,FDMS,ND2X3,IP12,IP16,
B ISTAV,L3264B,L3264W,MISTOT,IER)
C
C FEBRUARY 1995 GLAHN TDL MOS-2000
C AUGUST 1996 GLAHN ADDED MISTOT
C OCTOBER 1996 GLAHN CHANGED 1-D AND 2-D IDENTIFIERS
C OCTOBER 1996 GLAHN WIND IDS FROM 004011 AND 004111
C TO 004101 AND 004110
C NOVEMBER 1996 GLAHN ADDED KFILRA, RACESS, NUMRA, ICALLD
C DECEMBER 1996 GLAHN ADDED SUBROUTINE COMBIN
C JUNE 1997 GLAHN D COMPILE OPTION COMMENTED OUT
C DIAGNOSTIC CHANGE AT 198, 199
C JANUARY 1998 GLAHN ADDED SUBSTITUTE STATIONS IN CCALL( , )
C MAY 1998 GLAHN ADDED ITIMEZ( );
C IER=99 CHANGED TO IER=-1
C SEPTEMBER 1998 GLAHN ISTAV( ) CHANGED TO = 1 FOR IER = -1
C OCTOBER 1998 GLAHN ELIMINATED DIAGNOSTIC FOR CCC = 799
C OCTOBER 1998 GLAHN CHANGED CALL TO CONST
C NOVEMBER 1998 GLAHN CHANGED DIMENSIONS OF CCALLD( )
C AND ICALLD( , ) FROM ND1 TO ND5;
C ELIMINATED ISDATA( ) IN CALL TO CONST
C NOVEMBER 1998 GLAHN ADDED DIR2UV TO CALL
C DECEMBER 1998 GLAHN ADDED DATE TO DIAGNOSTIC; IER=120
C FROM CONST TREATED DIFFERENTLY
C JANUARY 1999 GLAHN CHANGES TO IER CODES AND DIAGNOSTICS
C IDS FOR WSPEED AND EOWND TAKEN FROM SFANOS
C JANUARY 1999 SFANOS ADDED COMMENTS AND CALLS TO THE
C FOLLOWING SUBROUTINES:
C POTEMP,MIXRAT,SPECHUM,MEANRH,DEWPT,
C WETBULBT,LCL,DPTDPR,TPCP3,TPCP6,TPCP12,
C TPCP24,NONCNVP,MDIV,WINDDR,KINDEX,
C TTOTALS,SWEATI,DIR2UV,OBSDMAXT,OBSDMINT,
C PCPX6,SVRVEC,KINXRF,OBSTCLD,OBSCIGHT
C APRIL 1999 SFANOS ADDED COMMENTS AND CALLS TO THE
C FOLLOWING SUBROUTINES:
C OBSPTYPE, OBSTCLD, SFCTCLD, CORDP, SNOWFL
C AUGUST 1999 GLAHN ADDED IP12 TO CALL
C MAY 2000 DREWRY COMMENTED OUT CALLS TO SVRVEC.F, KINXRF.F,
C RHVV.F, AND THETAE.F, IN ORDER TO RUN
C U201 WITH THE SUBROUTINES CURRENTLY EXISTING
C IN THE OPERATIONAL U201 LIBRARY ON THE IBM
C JUNE 2000 ALLEN ADDED COMMENTS AND CALLS TO: FRZLVL, SSR,
C ZRPRED, OBSTWET, OBSPRWXBIN. UNCOMMENTED
C CALL TO RHVV.
C JUNE 2000 ALLEN ADDED CALLS TO VORTADV, AND TMPADV
C JULY 2000 DALLAVALLE ADDED CALLS TO OBSPOPO, OBSPOPO3,
C AND OBSPOPC.
C AUGUST 2000 DALLAVALLE ADDED CALL TO LINDEX; UNCOMMENTED
C CALLS TO KINXRF, SVRVEC, THETAE
C SEPTEMBER 2000 MCE COMMENTED OUT CALL TO OBSPOPO3 - ROUTINE
C IS NOT WORKING YET.
C SEPTEMBER 2000 ALLEN ADDED CALL TO QADV, ADJUSTED CALL TO OBSTWET
C SEPTEMBER 2000 DALLAVALLE CORRECTED CALL TO KINXRF AND SVRVEC.
C SEPTEMBER 2000 DALLAVALLE ADDED CALL TO OBSOBVIS, CORRECTED CALL
C TO OBSDPTD.
C NOVEMBER 2000 GLAHN CORRECTED SPELLING IN COMMENTS
C JUNE 2001 DALLAVALLE ADDED CALLS TO OBSMRPTYPE AND
C OBSMRCLD
C FEBRUARY 2002 GLAHN CHANGED ND12 TO NUMRA IN ONE COMMENT
C JULY 2002 RLC UNCOMMENTED CALL TO OBSPOPO3, ADDED CALLS
C TO SWTXRF, PBLMIX, AND MODELMXMN. ADDED
C CALL TO SATLEVRH, BUT LEFT IT COMMENTED OUT
C TILL CONSTG IS ADDED TO U201
C AUG 2002 SFANOS CHANGED CALLS TO TPCP3, TPCP6, TPCP12; THEY
C HAD NONCNVP IDS IN THEM; CHANGED NONCNVP -
C OLDER VERSION IN LIBRARY
C AUGUST 2002 RLC UNCOMMENTED & CHANGED CALL TO SATLEVRH
C OCTOBER 2002 CARROLL ADDED EXPERIMENTAL CODES TEMPCORR, DEWPCORR
C AND THKCORR. THEY ARE COMMENTED OUT FOR
C POSSIBLE LATER USE.
C OCTOBER 2002 WEISS ARGUMENT LIST CHANGE TO SATLEVRH
C OCTOBER 2002 CARROLL CHANGED CALL TO PCPX6 (FOR JCM).
C NOVEMBER 2002 MCALOON LIBRARY WEEK - UPDATE TO INCLUDE CALLS FROM
C DALLAVALLE 06/2001
C NOVEMBER 2002 MCALOON LIBRARY WEEK - ADDED CALL TO OBSMRWSP FROM
C ERICKSON VERSION
C JANUARY 2003 GLAHN/WEISS ADDED NGRID AND NAME( ) TO CALL;
C MODIFIED CALL TO CONST AND OTHERS
C NOTE: ORIGINALLY FOR VERSION U204
C FEBRUARY 2003 WEISS ANOTHER ARGUMENT LIST CHANGE TO SATLEVRH
C ADDED CALLS TO TSLOP AND UPSLOP. ALSO
C ADDED A SPECIAL CALL TO CONST FOR WHEN ONLY
C TERRAIN HEIGHT IS REQUESTED AS A PREDICTOR.
C FEBRUARY 2003 WEISS CHANGED CALL TO CONST TO CONST1.
C APRIL 2003 GLAHN ADDED ARGUMENTS TO CALL TO DEWPCORR
C MAY 2003 GLAHN REVISED CALL TO OBSMRCLD, OBSCIGHT,
C SWTXRF, OBSTCLD, SVRVEC, TPCP24, SFCTCLD,
C WETBULBT, SSR, OBSMRCLD.
C JUNE 2003 GLAHN INSETED NGRID AND NAME IN CALL TO VERTP
C JUNE 2003 GLAHN ADDED 004061 AND 004161 IN CALL TO EOWND
C JUNE 2003 RLC ALLOWED FOR TWO VERSIONS OF TPCP24. _OLD
C IS THE OLD VERSION WITH THE INCORRECT
C ALGORITHM. IT STILL HAS THE ORIGINAL IDS.
C TPCP24 IS THE CORRECT VERSION AND HAS NEW
C IDS. TPCP24_OLD CAN BE REMOVED ONCE ALL
C QPF AND TSVR EQNS ARE REDEVELOPED.
C JULY 2003 RLC ALLOWED FOR TWO VERSIONS OF FRZLVL AND ZRPRED.
C _OLD ARE THE OLD VERSIONS WITH THE INCORRECT
C ALGORITHMS. THEY STILL HAVE THE ORIGINAL IDS.
C FRZLVL AND ZRPRED ARE THE CORRECT VERSIONS
C AND HAVE NEW IDS. THE _OLD VERSIONS CAN BE
C REMOVED ONCE ALL PTYPE EQNS ARE REDEVELOPED.
C JULY 2003 RLC ADDED CALLS FOR SNOW PREDICTOR AND PREDICTAND
C ROUTINES.
C JULY 2003 GLAHN ADDED NAME TO CALL TO UPSLOP
C AUGUST 2003 GLAHN ADDED EXTRA CHECKS BEFORE UPSLOP AND TSLOP
C AUGUST 2003 GLAHN CHANGED PACK TO IPACK IN CALL TO OBSOBVIS;
C ADDED CALL TO TIMTRP
C SEPTEMBER 2003 GLAHN ADDED CALL TO TIMGRD
C OCTOBER 2003 GLAHN ADDED MISTOT TO CALL TO TIMGRD
C NOVEMBER 2003 RLC ADDED CALL TO SATLEVNUM
C JANUARY 2004 RLC ADDED FD5 TO CALL TO WETBULBT AND NEW FFF TO
C SPECHUM AND DEWPT FOR ETA32 WORK.
C APRIL 2004 CMM ADDED CALL TO RHNSPD FOR VISOBVIS.
C APRIL 2004 RLC MODIFIED CALL TO ZRPRED
C JANUARY 2005 ANTOLIK MADE CHANGES REQUIRED FOR 2005 U201LIB UPDATE:
C RECONCILED NEW DEVELOPMENTAL, HRG, AND
C OPERATIONAL VERSIONS; ADDED CALLS TO HLCTY
C BULKRN, ADTEMP, AND LAPSER; MODIFIED CALLS TO
C NONCNVP,TPCP24, UPSLOP, AND WSPEED.
C APRIL 2005 RLC MADE MORE CHANGES FOR THE 2005 U201LIB UPDATE.
C FOR THE DEVELOPMENTAL OPTION, TOOK OUT CALLS
C TO _OLD ROUTINES. ALSO COMMENTED OUT CALLS
C TO SWTXRF AND RHNSPD BECAUSE THESE ROUTINES
C NEED SOME WORK BEFORE THEY ARE READY TO BE
C USED.
C APRIL 2005 RLC CHANGED CALL TO ADTEMP TO ADJTMP, ADDED CALLS
C TO U202 SUBROUTINES SHFTMXMN, CKTMPDP,
C FTOKGRD. UNCOMMENTED CALL TO LAPSER.
C MAY 2005 ANTOLIK MOVED CALL TO TIMTRP TO NEAR TOP OF SEQUENCE.
C JUNE 2005 OPS FIXED CALL TO TIMTRP.
C JUNE 2005 RLC TOOK DEVELOPMENTAL VERSION AND CREATED A NEW
C OPERATIONAL VERSION. ADDED IN _OLD ROUTINES
C FOR FRZLVL, ZRPRED AND TPCP24. ADDED BACK IN
C CALL TO ADTEMP IN CASE ANYTHING WAS STILL USING
C IT. PUT THE OLD SWTXRF CALL BACK BECAUSE WE'RE
C USING IT OPERATIONALLY. CALLED IT
C SWTXRF_OLD. TOOK OUT COMMENTED OUT
C CALLS TO BULKRN AND HELCTY UNTIL WE ACTUALLY
C USE THEM. PUT IN CALL TO WINDSP WHICH HADN'T
C MADE IT TO DEV LIBRARY YET.
C AUG 2005 RLC ADDED AN ID TO THE CALL TO FTOKGRD. ADDED CALLS
C TO NEW U202 ROUTINES CKBOUNDS, CMPDPGR, AND
C CMPRHGR. MODIFIED CALL TO BULKRN TO MATCH NEW
C VERSION OF ROUTINE. CHANGED EXISTING KINXRF
C CALL TO _OLD AND ADDED RACHEL'S NEW VERSION.
C SEP 2005 RLC MODIFIED CALL TO CKBOUNDS TO ADD POPS.
C SEP 2005 RLC ADDED CALL TO NEW ROUTINE GRDUNTCVT WHICH DOES
C VARIOUS UNIT CONVERSIONS FOR THE GRIDDED MOS.
C THIS ROUTINE REPLACED FTOKGRD, SO REMOVED THAT
C CALL.
C JAN 2006 KKG MODIFIED CALL TO GRDUNTCVT TO ADD THUNDERSTORMS.
C MAR 2006 RLC MODIFIED CALL TO GRDUNTCVT TO ADD
C WIND SPEED. ADDED NEW ROUTINE CMPWDRGR TO
C COMPUTE GRIDDED WIND DIRECTION. ADDED NEW
C ROUTINE CKWSPDGR TO SET WIND SPEED IN CALM
C WIND SITUATIONS
C APRIL 2007 JCM ADDED CALL TO ROUTINE CKWNDGST, WHICH ENSURES
C WIND GUST(MAX WIND SPEED) IS AT LEAST AS GREAT
C AS THE WIND SPEED FOR GRIDDED MOS. ADDED 224394
C AND 228399 TO GRDUNTCVT CALL.
C APRIL 2007 RLC ADDED SNOW AMT IDS TO CALLS TO GRDUNTCVT AND
C SHFTMXMN.
C MAY 2007 JCM ADDED CALL TO CKGPOP, WHICH ENSURES CONSISTENCY
C BETWEEN 6-H AND 12-H POPS.
C MAY 2007 RLC ADDED QPF IDS TO GRDUNTCVT
C JUNE 2007 RLC ADDED MORE QPF IDS TO GRDUNTCVT
C JUNE 2007 JCM ADDED ALL TO CMPQPFGR, WHICH CALCULATES 12-H QPF
C FROM 6-H QPF GRIDS.
C JUNE 2010 SDS ADDED 228084,228164,722034, 722134, 728004, AND
C 728104 TO GRDUNTCVT
C AUGUST 2014 JEG ADDED GOBS OPAQUE SKY COVER 728309 TO GRDUNTCVT
C SEPTEMBER 2014 JEG ADDED GLMP OPAQUE SKY COVER 228379 TO GRDUNTCVT
C DECEMBER 2014 JEG ADDED 724374 (WIND SPEED) CALL TO GRDUNTCVT
C NOVEMBER 2015 CH ADDED 724394 (WIND GUST) CALL TO GRDUNTCVT
C NOVEMBER 2015 CH ADDED 228074 (CIG PROB) AND 228134 (VIS PROB)
C CALL TO GRDUNTCVT
C DECEMBER 2016 FGS ADDED CALLS TO RATLGRD AND HRRRGRD.
C HRRRGRD MUST BE CALLED PRIOR TO
C MDIV. ADDED CALL TO MRMSQC.
C APRIL 2017 FGS UPDATED IDS IN CALLS TO RATLGRD,
C MRMSQC, AND HRRRGRD TO FINAL IDS.
C OCTOBER 2018 FGS ADDED CALLS TO HRRRGRD5, RAPGRD, AND
C PCPEFF. NOTE THAT IN FUTURE UPDATES
C THE STRUCTURE OF USING THE DD TO FIND
C THE CORRECT SUBROUTINE TO USE MAY
C HAVE TO CHANGE.
C
C PURPOSE
C TO CALL VARIOUS COMPUTATIONAL ROUTINES FOR PRED21 AND PRED22.
C MOST COMPUTATIONAL ROUTINES, WHEN NEEDING THEMSELVES A
C COMPUTED VARIABLE, WILL CALL OPTN2 RATHER THAN RECALLING
C OPTION. HOWEVER, WHEN THE LINEARIZATION ROUTINES L1D OR L2D
C NEED A COMPUTED VARIABLE, THEY WILL CALL OPTION (A REENTRY).
C IN THIS CASE, THE COMPUTATION MUST NOT INVOLVE ANOTHER CALL TO
C L1D OR L2D. THE CALLING SEQUENCE TO A ROUTINE LIKE L1D OR
C VERTP CONTAINS ALL THE VARIABLES NEEDED FOR REENTRY TO OPTION
C OR ENTRY TO OPTN2; MORE SPECIFIC ROUTINES LIKE VORTH WILL
C NOT NEED ALL OF THESE VARIABLES. IT IS ASSUMED ANY
C SECONDARY MISSING VALUES HAVE BEEN REMOVED.
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 NFIRST = 1 FOR THE 1ST DATE.
C ID(J) = THE PREDICTOR ID (J=1,4). (INPUT)
C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE PREDICTOR
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 THRESH = THE BINARY THRESHOLD ASSOCIATED WITH IDPARS( ).
C (INPUT)
C JD(J) = THE BASIC INTEGER PREDICTOR ID (J=1,4).
C THIS IS THE SAME AS ID(J), EXCEPT THAT THE PORTIONS
C PERTAINING TO PROCESSING ARE OMITTED:
C B = IDPARS(3),
C T = IDPARS(8),
C I = IDPARS(13),
C S = IDPARS(14),
C G = IDPARS(15), AND
C THRESH.
C JD( ) IS USED TO IDENTIFY THE BASIC MODEL FIELDS
C AS READ FROM THE ARCHIVE. (INPUT)
C NDATE = THE DATE/TIME FOR WHICH PREDICTOR IS NEEDED. (INPUT)
C KFILRA(J) = HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000
C EXTERNAL RANDOM ACCESS FILES (J=1,NUMRA). (INPUT)
C RACESS(J) = THE FILE NAMES CORRESPONDING TO KFILRA(J) (J=1,NUMRA).
C (CHARACTER*60) (INPUT)
C NUMRA = THE NUMBER OF UNIT NUMBERS AND NAMES IN KFILRA( )
C AND RACESS( ). (INPUT)
C ICALL(L,K,J) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTEGER
C VARIABLE (L=1,L3264W) (K=1,ND5) (J=1,6).
C EQUIVALENCED TO CCALL( , ) (INPUT/OUTPUT)
C CCALL(K,J) = 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT
C LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE
C OUTPUT FOR (J=1) AND 5 POSSIBLE OTHER STATION
C CALL LETTERS (J=2,6) THAT CAN BE USED INSTEAD
C IF THE PRIMARY (J=1) STATION CANNOT BE FOUND
C IN AN INPUT DIRECTORY (K=1,NSTA). ALL STATION
C DATA ARE KEYED TO THIS LIST, EXCEPT POSSIBLY
C CCALLD( ). EQUIVALENCED TO ICALL( , ).
C (CHARACTER*8) (INPUT/OUTPUT)
C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTEGER
C VARIABLE (L=1,L3264W) (K=1,ND5).
C EQUIVALENCED TO CCALLD( ). (INTERNAL)
C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). THIS LIST IS USED
C IN L1D1 TO READ THE REGION LISTS. (CHARACTER*8)
C (INTERNAL)
C NAME(K) = NAMES OF STATIONS (K=1,NSTA). USED FOR PRINTOUT
C ONLY. (CHARACTER*20) (INPUT)
C NELEV(K) = ELEVATION OF STATIONS (K=1,NSTA). (INPUT)
C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (INPUT)
C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (INPUT)
C ITIMEZ(K) = TIME ZONE INDICATOR. THE NUMBER OF HOURS
C THE STATION IS DIFFERENT FROM UTC (K=1,NSTA).
C (INPUT)
C ISDATA(K) = WORK ARRAY (K=1,ND1). (INTERNAL)
C SDATA(K) = INTERPOLATED DATA TO RETURN, WHEN STATION DATA ARE
C BEING GENERATED (K=1,NSTA). (OUTPUT)
C SDATA1(K) = WORK ARRAY RESERVED FOR USE IN L2D2 (K=1,NSTA).
C (INTERNAL)
C L1DATA(K) = THE ARRAY RESERVED FOR USE BY LINEARIZATION
C ROUTINES (K=1,NSTA). (INTERNAL)
C DIR(K,J,M) = THE IX (J=1) AND JY (J=2) POSITIONS ON THE GRID
C FOR THE COMBINATION OF GRID CHARACTERISTICS M
C (M=1,NGRID) AND STATION K (K=1,NSTA) IN NGRIDC( ,M).
C (INPUT)
C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH.
C FIRST DIMENSION OF DIR( , , ). (INPUT)
C NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT WITH.
C (INPUT)
C NGRIDC(L,M) = HOLDS THE GRID CHARACTERISTICS (L=1,6) FOR EACH GRID
C COMBINATION (M=1,NGRID).
C L=1--MAP PROJECTION NUMBER (3=LAMBERT, 5=POLAR
C STEREOGRAPHIC).
C L=2--GRID LENGTH IN MILLIMETERS,
C L=3--LATITUDE AT WHICH GRID LENGTH IS CORRECT *10000,
C L=4--GRID ORIENTATION IN DEGREES *10000,
C L=5--LATITUDE OF LL CORNER IN DEGREES *10000,
C L=6--LONGITUDE OF LL CORNER IN DEGREES *10000.
C NGRID = THE NUMBER OF GRID COMBINATIONS IN DIR( , , ),
C MAXIMUM OF ND11. (INPUT)
C ND11 = MAXIMUM NUMBER OF GRID COMBINATIONS THAT CAN BE
C DEALT WITH ON THIS RUN. LAST DIMENSION OF
C NGRIDC( , ) AND DIR( , , ). (INPUT)
C NSLAB = THE NUMBER OF THE SLAB IN DIR( , , ) AND
C IN NGRIDC( , ) DEFINING THE CHARACTERISTICS
C OF THIS GRID. SEE LSTORE(10, ). FOR THE
C COMPUTATION ROUTINES RETURNING A GRID, THIS
C VALUE MUST BE OUTPUT BY GFETCH. (OUTPUT)
C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C DATA(J) = ARRAY TO HOLD RETURNED DATA WHEN THE DATA ARE
C AT GRIDPOINTS. (J=1,ND5). (OUTPUT)
C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ).
C (INPUT)
C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA
C STORED (L=1,12) (J=1,LITEMS). (INPUT/OUTPUT)
C L=1,4--THE 4 ID'S FOR THE DATA.
C L=5 --LOCATION OF STORED DATA. WHEN IN CORE,
C THIS IS THE LOCATION IN CORE( ) WHERE
C THE DATA START. WHEN ON DISK,
C THIS IS MINUS THE RECORD NUMBER WHERE
C THE DATA START.
C L=6 --THE NUMBER OF 4-BYTE WORDS STORED.
C L=7 --2 FOR DATA PACKED IN TDL GRIB, 1 FOR NOT.
C L=8 --THE DATE/TIME OF THE DATA IN FORMAT
C YYYYMMDDHH.
C L=9 --NUMBER OF TIMES DATA HAVE BEEN RETRIEVED.
C L=10 --NUMBER OF THE SLAB IN DIR( , ,L) AND
C IN NGRIDC( ,L) DEFINING THE CHARACTERISTICS
C OF THIS GRID.
C L=11 --THE NUMBER OF THE PREDICTOR 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 MOSTORE( , ).
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 FOR MOS-2000 INTERNAL
C STORAGE. INITIALIZED TO 0 ON FIRST ENTRY TO GSTORE.
C ALSO INITIALIZED IN U201 IN CASE GSTORE IS NOT ENTERED.
C MUST BE CARRIED WHENEVER GSTORE IS TO BE CALLED.
C (INPUT/OUTPUT)
C NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM
C DISK FILE. (INPUT)
C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK FOR MOS-2000
C INTERNAL STORAGE. MUST BE CARRIED WHENEVER GSTORE
C IS TO BE CALLED. (INPUT)
C NSTORE = THE NUMBER OF TIMES GSTORE HAS BEEN ENTERED. GSTORE
C KEEPS TRACK OF THIS AND RETURNS THE VALUE. (OUTPUT)
C NFETCH = THE NUMBER OF TIMES GFETCH HAS BEEN ENTERED. GFETCH
C KEEPS TRACK OF THIS AND RETURNS THE VALUE. (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 FD1(J),FD2(J), ETC = WORK ARRAYS (J=1,ND2X3). THESE MAY BE USED IN
C ROUTINES AS 2-DIMENSIONAL ARRAYS, WHERE THE
C TOTAL ARRAY SIZE IS ND2*ND3=ND2X3 AS DECLARED IN
C THE CALLING PROGRAM. (INTERNAL)
C FDVERT(J) = TEMPORARY STORAGE RESERVED FOR SUBROUTINE VERTP
C (J=1,ND2X3). (INTERNAL)
C FDTIME(J) = TEMPORARY STORAGE RESERVED FOR SUBROUTINE TEMEP
C (J=1,ND2X3). (INTERNAL)
C FDSINS(IX,JY) = USED TO SAVE THE SIN OF THE LATITUDE IN SUBROUTINE
C PSMAPF (IX=1,NX) (JY=1,NY). THE USER MUST NOT
C USE THIS ARRAY EXCEPT IN CALLING PSMAPF.
C (INPUT/OUTPUT)
C FDMS(IX,JY) = USED TO SAVE THE MAP FACTOR IN SUBROUTINE
C PSMAPF (IX=1,NX) (JY=1,NY). THE USER MUST NOT
C USE THIS ARRAY EXCEPT IN CALLING PSMAPF.
C (INPUT/OUTPUT)
C ND2X3 = DIMENSION OF FD1( ), FD2( ), ETC. (INPUT)
C IP12 = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF
C STATIONS ON THE INPUT VECTOR FILES WILL BE WRITTEN
C TO UNIT IP12. (INPUT)
C IP16 = DIAGNOSTICS FOR LINEARIZATION AND CONSTANT ROUTINES
C (E.G., STATIONS IN THRESHOLD LISTS THAT ARE NOT
C BEING DEALT WITH IN THIS RUN). (INPUT)
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. (OUTPUT)
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. (INPUT)
C MISTOT = TOTAL NUMBER OF TIMES A MISSING INDICATOR
C HAS BEEN ENCOUNTERED IN UNPACKING GRIDS.
C (INPUT/OUTPUT)
C IER = STATUS RETURN.
C 0 = GOOD RETURN.
C -2 = PREDICTOR NOT DEFINED IN OPTION.
C 120 = ONE OR MORE STATIONS NOT DEFINED IN
C CONSTANT FILE
C 47 = DATA NOT FOUND
C SEE CALLED ROUTINES FOR OTHER VALUES.
C (INTERNAL-OUTPUT)
C
C NONSYSTEM SUBROUTINES USED
C VERTP, TIMEP, VORTW, VORTH, WSPEED, EOWND, GWIND, DIVW,
C FORIER, L1D, TESTS, POTEMP, MIXRAT, SPECHUM, MEANRH,
C DEWPT, WETBULBT, LCL, DPTDPR, TPCP3, TPCP6, TPCP12, TPCP24,
C NONCNVP, MDIV, WINDDR, KINDEX, TTOTALS, SWEATI, DIR2UV,
C OBSDMAXT, OBSDMINT, PCPX6, SVRVEC, KINXRF, OBSTCLD, OBSCIGHT,
C OBSPTYPE, OBSTCLD, SFCTCLD, CORDP, SNOWFL, RHVV, FRZLVL, SSR,
C ZRPRED, OBSTWET, OBSPRWXBIN, VORTADV, TMPADV, QADV, OBSPOPC,
C OBSPOPO, OBSPOPO3, LINDEX, OBSOBVIS, OBSDPTD, SWTXRF, PBLMIX,
C SATLEVRH, MODELMXMN, OBSMRPTYPE, OBSMRCLD, OBSMRWSP, SNOWEQ,
C OBSCPCPOS, OBSCPSNOW, OBSCPPRCP, SATLEVNUM, TIMTRP, TSLOP,
C UPSLOP, HELCTY, BULKRN, RHNSPD, ADJTMP, SHFTMXMN, CKTMPDP,
C CKBOUNDS, CMPDPGR, CMPRHGR, GRDUNTCVT, CMPWDRGR, CMPWSPDGR,
C CKWNDGST, CKGPOP, CMPQPFGR, HRRRGRD, RATLGRD
C
CHARACTER*8 CCALL(ND1,6),
1 CCALLD(ND5)
CHARACTER*20 NAME(ND1)
CHARACTER*60 RACESS(NUMRA)
C
DIMENSION ICALL(L3264W,ND1,6),
1 NELEV(ND1),STALAT(ND1),STALON(ND1),ITIMEZ(ND1),
2 ISDATA(ND1),SDATA(ND1),SDATA1(ND1),L1DATA(ND1)
DIMENSION DIR(ND1,2,ND11),NGRIDC(6,ND11)
DIMENSION ID(4),IDPARS(15),JD(4)
DIMENSION FD1(ND2X3),FD2(ND2X3),FD3(ND2X3),FD4(ND2X3),
1 FD5(ND2X3),FD6(ND2X3),FD7(ND2X3),
2 FDVERT(ND2X3),FDTIME(ND2X3),FDSINS(ND2X3),FDMS(ND2X3)
DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5),ICALLD(L3264W,ND5)
DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7)
DIMENSION LSTORE(12,ND9)
DIMENSION CORE(ND10)
DIMENSION KFILRA(NUMRA)
C
C WRITE(KFILDO,100)(ID(J),J=1,4),(IDPARS(J),J=1,15)
C100 FORMAT(' *********** IN OPTION *************'/' '4I10,15I5)
C
IER=0
C
C LOOK FOR 1-DIMENSIONAL LINEARIZATION ROUTINES.
C
IF(IDPARS(1).GE.500.AND.IDPARS(1).LE.599)THEN
CALL L1D(KFILDO,KFIL10,IP12,IP16,NFIRST,
1 ID,IDPARS,THRESH,JD,NDATE,
2 KFILRA,RACESS,NUMRA,
3 ICALL,CCALL,ICALLD,CCALLD,NAME,
4 NELEV,STALAT,STALON,
5 ITIMEZ,ISDATA,SDATA,SDATA1,L1DATA,DIR,ND1,NSTA,
6 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
7 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
8 NBLOCK,LASTD,NSTORE,NFETCH,
9 IS0,IS1,IS2,IS4,ND7,
A FD1,FD2,FD3,FD4,FD5,FD6,FD7,
B FDVERT,FDTIME,FDSINS,FDMS,ND2X3,
C ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR 2-DIMENSIONAL LINEARIZATION ROUTINES.
C
ELSEIF(IDPARS(1).GE.600.AND.IDPARS(1).LE.699)THEN
CALL L2D(KFILDO,KFIL10,IP12,IP16,NFIRST,
1 ID,IDPARS,THRESH,JD,NDATE,
2 KFILRA,RACESS,NUMRA,
3 ICALL,CCALL,ICALLD,CCALLD,NAME,
4 NELEV,STALAT,STALON,
5 ITIMEZ,ISDATA,SDATA,SDATA1,L1DATA,DIR,ND1,NSTA,
6 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
7 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
8 NBLOCK,LASTD,NSTORE,NFETCH,
9 IS0,IS1,IS2,IS4,ND7,
A FD1,FD2,FD3,FD4,FD5,FD6,FD7,
B FDVERT,FDTIME,FDSINS,FDMS,ND2X3,
C ISTAV,L3264B,L3264W,MISTOT,IER)
C
C THE SUBROUTINE COMBIN IS AN EXAMPLE OF HOW DATA
C FROM TWO (OR MORE) MODELS COULD BE COMBINED.
C COMBIN CAN BECOME A SWITCHER IF NEEDED, SIMILAR
C TO L1D AND L2D.
C
ELSEIF(IDPARS(1).GE.300.AND.IDPARS(1).LE.399)THEN
CALL COMBIN(KFILDO,KFIL10,IP12,IP16,NFIRST,
1 ID,IDPARS,THRESH,JD,NDATE,
2 KFILRA,RACESS,NUMRA,
3 ICALL,CCALL,ICALLD,CCALLD,NAME,
4 NELEV,STALAT,STALON,
5 ITIMEZ,ISDATA,SDATA,SDATA1,L1DATA,DIR,ND1,NSTA,
6 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
7 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
8 NBLOCK,LASTD,NSTORE,NFETCH,
9 IS0,IS1,IS2,IS4,ND7,
A FD1,FD2,FD3,FD4,FD5,FD6,FD7,
B FDVERT,FDTIME,FDSINS,FDMS,ND2X3,
C ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF 3-CYCLE AVERAGE FOR RAP.
C ENTERED WHEN IDPARS(5)=0 AND IDPARS(6) != 0. THIS
C ROUTINE IS FOR GRIDDED FIELDS THAT ARE AVAILABLE
C DIRECTLY ON INPUT (WHICH MAY HAVE BEEN COMPUTED
C A PRIORI IN U202).
C
ELSEIF((IDPARS(4).EQ.03).AND.
1 IDPARS(5).EQ.0.AND.IDPARS(6).GT.0)THEN
CALL CYCAVG3_RAP(KFILDO,KFIL10,JD,IDPARS,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,ND2X3,
4 ISTAV,L3264B,MISTOT,IER)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C TIME INTERPOLATE CERTAIN FORECASTS TO HOURLY VALUES.
C TIMTRP RETURNS VECTOR DATA OR GRIDPONT DATA, DEPENDING
C ON ISTAV.
C
C ELSEIF((MOD(IDPARS(12),3).NE.0).AND.((IDPARS(1)/100).EQ.2.OR.
c 1 (IDPARS(1)/10.EQ.0.AND.IDPARS(4).NE.5)))THEN
c CALL TIMTRP(KFILDO,KFIL10,NFIRST,
c 1 ID,IDPARS,THRESH,JD,NDATE,
c 2 KFILRA,RACESS,NUMRA,
c 3 ICALL,CCALL,ICALLD,CCALLD,NAME,
c 4 NELEV,STALAT,STALON,
c 5 ITIMEZ,ISDATA,SDATA,SDATA1,DIR,ND1,NSTA,
c 6 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
c 7 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
c 8 IS0,IS1,IS2,IS4,ND7,
c 9 FD1,FD2,FD3,FD4,FD5,FD6,FD7,
c A FDVERT,FDTIME,FDSINS,FDMS,ND2X3,
c B ISTAV,L3264B,L3264W,MISTOT,IER)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C LOOK FOR SIMPLE VERTICAL COMPUTATION. ALLOWANCE IS MADE
C FOR POSSIBILITY THAT THE FIELDS INVOLVED HAVE TO BE
C COMPUTED. VERTP IS NOT ENTERED UNLESS IDPARS(10) = 0.
C THIS MEANS THAT WHEN BOTH VERTICAL COMPUTATION AND
C TIME COMPUTATION IS DONE, TIME IS ENTERED FIRST SO
C THAT VERTICAL COMPUTATION IS DONE WITHIN IT.
C
ELSEIF(IDPARS(5).GT.0.AND.IDPARS(10).EQ.0)THEN
CALL VERTP(KFILDO,KFIL10,NFIRST,
1 ID,IDPARS,THRESH,JD,NDATE,
2 KFILRA,RACESS,NUMRA,
3 ICALL,CCALL,ICALLD,CCALLD,NAME,
4 NELEV,STALAT,STALON,
5 ITIMEZ,ISDATA,SDATA,SDATA1,DIR,ND1,NSTA,
6 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
7 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,FD3,FD4,FD5,FD6,FD7,
A FDVERT,FDTIME,FDSINS,FDMS,ND2X3,
B ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR SIMPLE TIME COMPUTATION. ALLOWANCE IS MADE
C FOR POSSIBILITY THAT THE FIELDS INVOLVED HAVE TO BE
C COMPUTED. TIMEP IS ENTERED WHEN IDPARS(10) GT 0, NO
C MATTER WHETHER OR NOT IDPARS(5) = 0.
C
ELSEIF(IDPARS(10).GT.0)THEN
CALL TIMEP(KFILDO,KFIL10,NFIRST,
1 ID,IDPARS,THRESH,JD,NDATE,
2 KFILRA,RACESS,NUMRA,
3 ICALL,CCALL,ICALLD,CCALLD,NAME,
4 NELEV,STALAT,STALON,
5 ITIMEZ,ISDATA,SDATA,SDATA1,DIR,ND1,NSTA,
6 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
7 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,FD3,FD4,FD5,FD6,FD7,
A FDVERT,FDTIME,FDSINS,FDMS,ND2X3,
B ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR THE COMPUTATION OF THE TERRAIN SLOPE.
C MUST PRECEED CALL TO CONST1.
C
ELSEIF(IDPARS(1).EQ.409.AND.IDPARS(2)/100.GE.3.AND.
1 (IDPARS(2)-(IDPARS(2)/10)*10.NE.0))THEN
CALL TSLOP(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 KFILRA,RACESS,NUMRA,
2 CCALL,NAME,SDATA,STALAT,STALON,DIR,ND1,NSTA,
3 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
4 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
5 IS0,IS1,IS2,IS4,ND7,
6 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
7 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR THE COMPUTATION OF THE UPSLOPE OF THE WIND.
C
ELSEIF(IDPARS(1).EQ.005.AND.IDPARS(2)/100.GE.3)THEN
CALL UPSLOP(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 KFILRA,RACESS,NUMRA,
2 CCALL,NAME,SDATA,STALAT,STALON,DIR,ND1,NSTA,
3 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
4 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
5 IS0,IS1,IS2,IS4,ND7,
6 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
7 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR CONSTANT DATA, TO BE PROVIDED IN
C THE MOS-2000 EXTERNAL RANDOM ACCESS FILES.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
ELSEIF(IDPARS(1).GE.400.AND.IDPARS(1).LE.499)THEN
C
CALL CONST1(KFILDO,KFIL10,IP12,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,
3 CCALL,ICALLD,CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,
6 IPACK,IWORK,DATA,ND5,
7 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
8 NBLOCK,LASTD,NSTORE,NFETCH,
9 IS0,IS1,IS2,IS4,ND7,
A ISTAV,L3264B,L3264W,IER)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C LOOK FOR COMPUTATION OF 12-H MAX OR MIN FROM MODEL DATA
C
ELSEIF(((IDPARS(1).EQ.002)).AND.((IDPARS(2).EQ.051).OR.
1 (IDPARS(2).EQ.061)))THEN
CALL MODELMXMN(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF ELEVATION-ADJUSTED TEMPERATURE
C
ELSEIF(IDPARS(1).EQ.002.AND.IDPARS(2).EQ.081) THEN
CALL ADJTMP(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 KFILRA,RACESS,NUMRA,CCALL,ICALLD,CCALLD,
2 NAME,NELEV,STALAT,STALON,ISDATA,SDATA,
3 DIR,ND1,NSTA,NGRIDC,NGRID,ND11,NSLAB,
4 IPACK,IWORK,DATA,ND5,LSTORE,ND9,LITEMS,
5 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,FD1,FD2,FD3,FD4,
7 ND2X3,IP12,IP16,ISTAV,L3264B,L3264W,
8 MISTOT,IER)
C
C LOOK FOR COMPUTATION OF ADJUSTED TEMPERATURE
C ORIGINAL VERSION - SHOULD NO LONGER BE USED AS OF
C MARCH 1, 2005 (JPD). KEPT IN OPER VERSION FOR NOW
C IN CASE ANYTHING IS USING IT.
C
ELSEIF(IDPARS(1).EQ.002.AND.(IDPARS(2).EQ.071)) THEN
CALL ADTEMP(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,ND2X3,ISTAV,
4 L3264B,MISTOT,
5 FD1,FD2,FD3,FD4,FD5,FD6,FD7,KFILRA,RACESS,NUMRA,ND1,
6 CCALL,ICALLD,CCALLD,ISDATA,SDATA,NSTA,
7 NAME,STALAT,STALON,NGRID,
8 LASTL,LASTD,NSTORE,IP16,L3264W,DIR,IP12,IER)
C
C LOOK FOR COMPUTATION OF ANY OF THE FOUR SSR PREDICTORS
C FROM MODEL DATA (NOTE: THIS PREDICTOR IS RETURNED AS
C VECTOR DATA)
C
ELSEIF(((IDPARS(1).EQ.001).AND.(IDPARS(2).EQ.700)).OR.
1 ((IDPARS(1).EQ.002).AND.(IDPARS(2).EQ.700)).OR.
2 ((IDPARS(1).EQ.002).AND.(IDPARS(2).EQ.710)).OR.
3 ((IDPARS(1).EQ.002).AND.(IDPARS(2).EQ.715)))THEN
CALL SSR(KFILDO,KFIL10,IP12,IDPARS,JD,NDATE,
1 KFILRA,RACESS,NUMRA,
2 CCALL,ICALLD,CCALLD,SDATA,ISDATA,
3 DIR,ND11,NSLAB,NSTA,ND1,
4 IPACK,IWORK,ND5,
5 LSTORE,ND9,LITEMS,CORE,ND10,
6 LASTL,NBLOCK,LASTD,NSTORE,NFETCH,
7 IS0,IS1,IS2,IS4,ND7,
8 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
9 ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF FREEZING LEVEL FROM MODEL DATA
C THIS CALL IS FOR THE CORRECT VERSION
C
ELSEIF(IDPARS(1).EQ.002.AND.(IDPARS(2).EQ.046.OR.
1 IDPARS(2).EQ.047.OR.
2 IDPARS(2).EQ.048.OR.
3 IDPARS(2).EQ.049)) THEN
CALL FRZLVL(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF FREEZING LEVEL FROM MODEL DATA
C THIS CALL IS FOR THE OLD INCORRECT VERSION
C
ELSEIF(IDPARS(1).EQ.002.AND.(IDPARS(2).EQ.042.OR.
1 IDPARS(2).EQ.043.OR.IDPARS(2).EQ.044.OR.
2 IDPARS(2).EQ.045)) THEN
CALL FRZLVL_OLD(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,FD1,FD2,FD3,FD4,
4 ND2X3,ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE POTENTIAL TEMPERATURE FROM
C MODEL DATA
C
ELSEIF(IDPARS(1).EQ.002.AND.(IDPARS(2).EQ.100.OR.
1 IDPARS(2).EQ.101.OR.
2 IDPARS(2).EQ.106)) THEN
CALL POTEMP(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF BOUNDARY LAYER LAPSE RATE
C
ELSEIF(IDPARS(1).EQ.002.AND.IDPARS(2).EQ.770) THEN
CALL LAPSER(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,ND2X3,ISTAV,
5 L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE BIAS CORRECTED DEWPOINT.
C
C ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.190.OR.
C 1 IDPARS(2).EQ.191)) THEN
C CALL DEWPCORR(KFILDO,KFIL10,IDPARS,JD,NDATE,
C 1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
C 2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
C 3 IS0,IS1,IS2,IS4,ND7,
C 4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
C 5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE BIAS CORRECTED THICKNESS.
C
C ELSEIF(IDPARS(1).EQ.001.AND.(IDPARS(2).EQ.090)) THEN
C CALL THKCORR(KFILDO,KFIL10,IDPARS,JD,NDATE,
C 1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
C 2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
C 3 IS0,IS1,IS2,IS4,ND7,
C 4 FD1,FD2,FD3,FD4,FD5,FD6,ND2X3,
C 5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF BIAS CORRECTED TEMPERATURE.
C
C ELSEIF(IDPARS(1).EQ.002.AND.(IDPARS(2).EQ.090.OR.
C 1 IDPARS(2).EQ.091.OR.
C 2 IDPARS(2).EQ.097)) THEN
C CALL TEMPCORR(KFILDO,KFIL10,IDPARS,JD,NDATE,
C 1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
C 2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
C 3 IS0,IS1,IS2,IS4,ND7,
C 4 FD1,FD2,FD3,FD4,ND2X3,
C 5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF MIXING RATIO FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.010.OR.
1 IDPARS(2).EQ.011.OR.
2 IDPARS(2).EQ.016)) THEN
CALL MIXRAT(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF SPECIFIC HUMIDITY FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.030.OR.
1 IDPARS(2).EQ.031.OR.
2 IDPARS(2).EQ.036.OR.
3 IDPARS(2).EQ.037)) THEN
CALL SPECHUM(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C COMPUTE MEAN RELATIVE HUMIDITY FOR
C A GIVEN ISOBARIC LAYER FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.040.OR.
1 IDPARS(2).EQ.041.OR.
2 IDPARS(2).EQ.042.OR.
3 IDPARS(2).EQ.043)) THEN
CALL MEANRH(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE UPS FOG POTENTIAL FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.IDPARS(2).EQ.067) THEN
CALL RHNSPD(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF DEW POINT TEMPERATURE FROM MODEL
C DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.100.OR.
1 IDPARS(2).EQ.101.OR.
2 IDPARS(2).EQ.106.OR.
3 IDPARS(2).EQ.107)) THEN
CALL DEWPT(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE WET BULB TEMPERATURE FROM MODEL
C DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.110.OR.
1 IDPARS(2).EQ.111.OR.
2 IDPARS(2).EQ.116)) THEN
CALL WETBULBT(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE EQUIVALENT POTENTIAL TEMPERATURE
C FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.130.OR.
1 IDPARS(2).EQ.131)) THEN
CALL THETAE(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF CORRECT ZRPRED FROM MODEL DATA
C
ELSEIF((IDPARS(1).EQ.003).AND.((IDPARS(2).EQ.152).OR.
1 (IDPARS(2).EQ.153).OR.
2 (IDPARS(2).EQ.154).OR.
3 (IDPARS(2).EQ.156))) THEN
CALL ZRPRED(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF OLD INCORRECT ZRPRED. USED
C ONLY IN OPER PTYPE EQNS PRIOR TO FALL 2003
C
ELSEIF((IDPARS(1).EQ.003).AND.((IDPARS(2).EQ.151).OR.
2 (IDPARS(2).EQ.155)))THEN
CALL ZRPRED_OLD(KFILDO,KFIL10,
1 IDPARS,JD,NDATE,NGRIDC,ND11,
2 NSLAB,IPACK,IWORK,DATA,ND5,LSTORE,ND9,
3 LITEMS,CORE,ND10,NBLOCK,NFETCH,IS0,IS1,
4 IS2,IS4,ND7,ND2X3,ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE LIFTED CONDENSATION
C LEVEL FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.160.OR.
1 IDPARS(2).EQ.161)) THEN
CALL LCL(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF DEW POINT DEPRESSION FROM MODEL
C DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.170.OR.
1 IDPARS(2).EQ.171.OR.
2 IDPARS(2).EQ.176)) THEN
CALL DPTDPR(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF 3 HOUR TOTAL OR CONVECTIVE
C PRECIPITATION FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.205.OR.
1 IDPARS(2).EQ.235))THEN
CALL TPCP3(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF 6 HOUR TOTAL OR CONVECTIVE
C PRECIPITATION FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.210.OR.
1 IDPARS(2).EQ.240))THEN
CALL TPCP6(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF 12 HOUR TOTAL OR CONVECTIVE
C PRECIPITATION FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.220.OR.
1 IDPARS(2).EQ.250))THEN
CALL TPCP12(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF 24 HOUR TOTAL OR CONVECTIVE
C PRECIPITATION FROM MODEL DATA. THIS IS THE
C VERSION REVISED IN 2002 WITH THE NEW IDS.
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.226.OR.
1 IDPARS(2).EQ.256))THEN
CALL TPCP24(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE OLD 24 HOUR TOTAL, CONVECTIVE,
C OR NON-CONVECTIVE PRECIPITATION FROM MODEL DATA. THIS IS
C THE ORIGINAL VERSION WITH THE ERROR IN IT. IT NEEDS TO
C BE KEPT AROUND FOR OPERATIONS UNTIL QPF AND TSVR EQNS
C ARE REDEVELOPED.
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.225.OR.
1 IDPARS(2).EQ.255.OR.
2 IDPARS(2).EQ.285))THEN
CALL TPCP24_OLD(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,
2 DATA,ND5,LSTORE,ND9,LITEMS,CORE,ND10,
3 NBLOCK,NFETCH,IS0,IS1,IS2,IS4,ND7,FD1,
4 FD2,FD3,ND2X3,ISTAV,L3264B,MISTOT,
5 IER)
C
C LOOK FOR COMPUTATION OF 3,6,12, OR 24 HOUR NON CONVECTIVE
C PRECIPITATION FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.265.OR.
1 IDPARS(2).EQ.270.OR.
2 IDPARS(2).EQ.280.OR.
3 IDPARS(2).EQ.286))THEN
CALL NONCNVP(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF SATLEVRH FROM MODEL DATA.
C SATLEVRH IS THE HEIGHT ABOVE THE GROUND OF A SPECIFIED
C RH LEVEL
C
ELSEIF((IDPARS(1).EQ.003).AND.((IDPARS(2).EQ.311).OR.
1 (IDPARS(2).EQ.321).OR.
2 (IDPARS(2).EQ.331).OR.
3 (IDPARS(2).EQ.312).OR.
4 (IDPARS(2).EQ.322).OR.
5 (IDPARS(2).EQ.332).OR.
6 (IDPARS(2).EQ.313).OR.
7 (IDPARS(2).EQ.323).OR.
8 (IDPARS(2).EQ.333)))THEN
CALL SATLEVRH(KFILDO,KFIL10,IP12,IDPARS,JD,NDATE,
1 KFILRA,RACESS,NUMRA,
2 CCALL,ICALLD,CCALLD,NAME,STALAT,STALON,
3 ISDATA,SDATA,DIR,ND1,NSTA,
4 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
5 LSTORE,ND9,LITEMS,CORE,ND10,
6 LASTL,NBLOCK,LASTD,NSTORE,NFETCH,
7 IS0,IS1,IS2,IS4,ND7,
8 FD3,FD4,ND2X3,
9 ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF SATLEVNUM FROM MODEL DATA.
C SATLEVNUM IS THE RELATIVE NUMBER OF LEVELS ABOVE THE GROUND
C EXCEEDING A SPECIFIED RH LEVEL
C
ELSEIF((IDPARS(1).EQ.003).AND.((IDPARS(2).EQ.341).OR.
1 (IDPARS(2).EQ.351).OR.
2 (IDPARS(2).EQ.361).OR.
3 (IDPARS(2).EQ.342).OR.
4 (IDPARS(2).EQ.352).OR.
5 (IDPARS(2).EQ.362).OR.
6 (IDPARS(2).EQ.343).OR.
7 (IDPARS(2).EQ.353).OR.
8 (IDPARS(2).EQ.363)))THEN
CALL SATLEVNUM(KFILDO,KFIL10,
1 IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,
3 CCALL,ICALLD,CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD2,FD3,FD4,ND2X3,
A IP12,ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF PRECIPITATION
C EFFICIENCY
C
ELSEIF(IDPARS(1).EQ.003.AND.IDPARS(2).EQ.370)THEN
CALL PCPEFF(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C CALL ROUTINES TO PERFORM HRRR GRID PROCESSING FOR LAMP
C CNV, LTG, AND POP. NOTE THE DD IN WORD 1 OF THE ID
C DETERMINES WHICH ROUTINE TO CALL.
C
ELSEIF((IDPARS(4).EQ.03).AND.
1 ((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR.
1 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.011).OR.
2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR.
3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.101).OR.
4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.651).OR.
5 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.355).OR.
6 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.202).OR.
7 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.501))) THEN
C
C SPECIFY ALL HRRR GRIDS NEEDED FOR LAMP CONVECTION. NOTE THAT
C SOME OF THESE GRIDS RESIDE IN THE HRRR GRID INGEST BUT C1 IN
C ID(1) HAD BEEN BOGUSSED FROM 0 TO 9 IN ORDER TO FORCE ENTRY
C TO OPTION. IN HRRRGRD ALL NEEDED HRRR GRIDS ARE SPECIFIED
C AND SPECIAL SMOOTHING IS APPLIED TO EACH GRID THEREIN.
C
C NOTE ALSO THAT CALL TO HRRRGRD MUST PRECEDE CALL TO TIMTRP.
C
CALL HRRRGRD(KFILDO,KFIL10,ID,IDPARS,NDATE,IPACK,
c 1 IWORK,DATA,NSLAB,ND5,
1 IWORK,DATA,NSLAB,ND5,ND1,NGRID,CCALL,NSTA,DIR,
2 FD1,FD2,FD3,FD4,FD5,FD6,FDSINS,FDMS,ND2X3,
3 NGRIDC,ND11,LSTORE,ND9,LITEMS,CORE,ND10,
4 NBLOCK,NFETCH,IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,L3264W,IER)
C
C RENDER 3-KM HRRR FIELDS TO 5-KM GRID FOR LAMP POP.
C NOTE THIS MUST PRECEDE CALL TO TIMTRP.
C
ELSEIF((IDPARS(4).EQ.33).AND.
1 ((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR.
1 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.011).OR.
2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR.
3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.101).OR.
4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.651).OR.
5 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.355).OR.
6 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.202).OR.
7 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.203).OR.
8 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.501))) THEN
C
CALL HRRRGRD5(KFILDO,KFIL10,ID,IDPARS,NDATE,IPACK,
1 IWORK,DATA,NSLAB,ND5,ND1,NGRID,CCALL,NSTA,DIR,
2 FD1,FD2,FD3,FD4,FD5,FD6,FDSINS,FDMS,ND2X3,
3 NGRIDC,ND11,LSTORE,ND9,LITEMS,CORE,ND10,
4 NBLOCK,NFETCH,IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,L3264W,IER)
C
C RENDER 2.5KM RAP FIELDS TO 5-KM GRID FOR LAMP POP.
C NOTE THIS MUST PRECEDE CALL TO TIMTRP.
C
ELSEIF((IDPARS(4).EQ.43).AND.
1 ((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR.
1 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.011).OR.
2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR.
3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.101).OR.
4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.651).OR.
5 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.355).OR.
6 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.202).OR.
7 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.203).OR.
8 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.501))) THEN
C
CALL RAPGRD(KFILDO,KFIL10,ID,IDPARS,NDATE,IPACK,
1 IWORK,DATA,NSLAB,ND5,ND1,NGRID,CCALL,NSTA,DIR,
2 FD1,FD2,FD3,FD4,FD5,FD6,FDSINS,FDMS,ND2X3,
3 NGRIDC,ND11,LSTORE,ND9,LITEMS,CORE,ND10,
4 NBLOCK,NFETCH,IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR MOISTURE DIVERGENCE FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.500.OR.
1 IDPARS(2).EQ.501.OR.
2 IDPARS(2).EQ.506))THEN
CALL MDIV(KFILDO,KFIL10,JD,IDPARS,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF 24-HR SNOWFALL AMOUNT FROM
C MODEL DATA
C
ELSEIF(IDPARS(1).EQ.003.AND.(IDPARS(2).EQ.640.OR.
1 IDPARS(2).EQ.645))THEN
CALL SNOWEQ(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF EARTH-ORIENTED U-WIND OR V-WIND
C FROM MODEL DATA
C IT IS ASSUMED THE GRID-ORIENTED WIND FIELDS ARE BASIC VARIABLES.
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.010.OR.
1 IDPARS(2).EQ.110.OR.
2 IDPARS(2).EQ.011.OR.
3 IDPARS(2).EQ.111.OR.
4 IDPARS(2).EQ.061.OR.
5 IDPARS(2).EQ.161.OR.
6 IDPARS(2).EQ.066.OR.
7 IDPARS(2).EQ.166))THEN
CALL EOWND(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF GEOSTROPHIC U-WIND, V-WIND, OR
C WIND SPEED FROM HEIGHTS FROM MODEL DATA
C IT IS ASSUMED THE HEIGHT FIELD IS A BASIC VARIABLE.
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.002.OR.
1 IDPARS(2).EQ.012.OR.
2 IDPARS(2).EQ.102.OR.
3 IDPARS(2).EQ.112.OR.
4 IDPARS(2).EQ.212))THEN
CALL GWIND(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF WIND DIRECTION FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.200.OR.
1 IDPARS(2).EQ.201.OR.
2 IDPARS(2).EQ.206))THEN
CALL WINDDR(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,
5 ND2X3,ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF WIND SPEED FROM U AND V WINDS
C FROM MODEL DATA
C IT IS ASSUMED THE U AND V WIND FIELDS ARE BASIC VARIABLES.
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.210.OR.
1 IDPARS(2).EQ.211.OR.
2 IDPARS(2).EQ.216))THEN
CALL WSPEED(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF STATION WIND SPEED FROM GRID U AND V
C WINDS FROM MODEL DATA. IT IS ASSUMED THE U AND V WIND FIELDS
C ARE BASIC VARIABLES.
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.260.OR.
1 IDPARS(2).EQ.261))THEN
CALL WINDSP(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,SDATA,DIR,ND1,
1 NSTA,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,FD1,FD2,FD3,FD4,FD5,FD6,
4 ND2X3,ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF VORTICITY ADVECTION FROM MODEL
C DATA
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.300.OR.
1 IDPARS(2).EQ.301.OR.
2 IDPARS(2).EQ.306)) THEN
CALL VORTADV(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF TEMPERATURE ADVECTION FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.320.OR.
1 IDPARS(2).EQ.321.OR.IDPARS(2).EQ.326)) THEN
CALL TMPADV(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF SPECIFIC HUMIDITY ADVECTION FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.004.AND.(IDPARS(2).EQ.350.OR.
1 IDPARS(2).EQ.351.OR.
2 IDPARS(2).EQ.356)) THEN
CALL QADV(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF DIVERGENCE FROM WINDS FROM MODEL
C DATA. IT IS ASSUMED THE U AND V WIND FIELDS ARE BASIC
C VARIABLES.
C
ELSEIF(IDPARS(1).EQ.006.AND.(IDPARS(2).EQ.110.OR.
1 IDPARS(2).EQ.111.OR.
2 IDPARS(2).EQ.116))THEN
CALL DIVW(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF VORTICITY FROM WINDS FROM MODEL
C DATA. IT IS ASSUMED THE WIND FIELD IS A BASIC VARIABLE.
C
ELSEIF(IDPARS(1).EQ.006.AND.IDPARS(2).EQ.010)THEN
CALL VORTW(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF VORTICITY FROM HEIGHTS (GEOSTROPHIC)
C OF MODEL DATA. IT IS ASSUMED THE HEIGHT FIELD IS A BASIC
C VARIABLE.
C
ELSEIF(IDPARS(1).EQ.006.AND.IDPARS(2).EQ.020)THEN
CALL VORTH(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FDSINS,FDMS,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION FOR STORM RELATIVE HELICITY
C
C ELSEIF(IDPARS(1).EQ.006.AND.IDPARS(2).EQ.310.OR.
C 1 IDPARS(2).EQ.320.OR.
C 2 IDPARS(2).EQ.330)THEN
C CALL HELCTY(KFILDO,KFIL10,IDPARS,JD,NDATE,
C 1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
C 2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
C 3 IS0,IS1,IS2,IS4,ND7,
C 4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
C 5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF BULK RICHARDSON NUMBER
C
ELSEIF(IDPARS(1).EQ.007.AND.
1 IDPARS(2).EQ.140.OR.IDPARS(2).EQ.150.OR.
2 IDPARS(2).EQ.145.OR.IDPARS(2).EQ.155)THEN
CALL BULKRN(KFILDO,KFIL10,
1 IDPARS,JD,NDATE,
2 SDATA,DIR,ND1,NSTA,
3 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
5 LSTORE,ND9,LITEMS,CORE,ND10,
6 LASTL,NBLOCK,LASTD,NSTORE,NFETCH,
7 IS0,IS1,IS2,IS4,ND7,
8 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF STABILITY PARAMETERS FOR
C LIGHTNING.
C
ELSEIF((IDPARS(1).EQ.002.AND.(IDPARS(2).EQ.003.OR.
1 IDPARS(2).EQ.004)).OR.
2 (IDPARS(1).EQ.007.AND.(IDPARS(2).EQ.021.OR.
3 IDPARS(2).EQ.104.OR.
4 IDPARS(2).EQ.105.OR.
5 IDPARS(2).EQ.121)))THEN
CALL LTGTHERMO(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,ND2X3,
4 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE KINDEX FROM MODEL DATA.
C
ELSEIF(IDPARS(1).EQ.007.AND.IDPARS(2).EQ.200)THEN
CALL KINDEX(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE LIFTED INDEX FROM MODEL DATA.
C
ELSEIF(IDPARS(1).EQ.007.AND.IDPARS(2).EQ.020)THEN
CALL LINDEX(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF TOTAL TOTALS INDEX FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.007.AND.IDPARS(2).EQ.210)THEN
CALL TTOTALS(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF SWEAT INDEX FROM MODEL DATA
C
ELSEIF(IDPARS(1).EQ.007.AND.IDPARS(2).EQ.220)THEN
CALL SWEATI(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE INTERACTIVE PREDICTOR
C SWTXRF FROM VECTOR DATA. THIS MULTIPLIES THE SWEAT
C INDEX TIMES THE SEVERE TSTM RELATIVE FREQUENCY
C
ELSEIF((IDPARS(1).EQ.007).AND.((IDPARS(2).GE.360)
1 .AND.(IDPARS(2).LE.390)))THEN
CALL SWTXRF_OLD(KFILDO,KFIL10,IDPARS,JD,NDATE,NGRIDC,ND11,
1 NSLAB,IPACK,IWORK,DATA,ND5,LSTORE,ND9,LITEMS,
2 CORE,ND10,NBLOCK,NFETCH,IS0,IS1,IS2,IS4,ND7,
3 ND2X3,ISTAV,L3264B,MISTOT,FD1,
4 FD2,FD3,FD4,FD5,FD6,FD7,KFILRA,RACESS,NUMRA,
5 ND1,CCALL,ICALLD,CCALLD,ISDATA,SDATA,NSTA,
* NAME,STALAT,STALON,NGRID,
6 LASTL,LASTD,NSTORE,IP16,L3264W,DIR,IP12,IER)
C
C LOOK FOR COMPUTATION OF PRODUCT OF RELATIVE
C HUMIDITY AND VERTICAL VELOCITY
C
ELSEIF(IDPARS(1).EQ.007.AND.IDPARS(2).EQ.420)THEN
CALL RHVV(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE PLANETARY BOUNDARY LAYER MIXING FROM
C MODEL DATA.
C
ELSEIF(IDPARS(1).EQ.007.AND.(IDPARS(2).EQ.500.OR.
1 IDPARS(2).EQ.510)) THEN
CALL PBLMIX(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C PERFORM MRMS QC
C
ELSEIF((IDPARS(1).EQ.707.AND.IDPARS(2).EQ.801).OR.
1 (IDPARS(1).EQ.707.AND.IDPARS(2).EQ.811).OR.
2 (IDPARS(1).EQ.707.AND.IDPARS(2).EQ.821).OR.
3 (IDPARS(1).EQ.703.AND.IDPARS(2).EQ.201).OR.
5 (IDPARS(1).EQ.703.AND.IDPARS(2).EQ.204)) THEN
CALL MRMSQC(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE,
1 CCALL,ICALLD,CCALLD,ISDATA,SDATA,DIR,ND1,NSTA,
2 IPACK,IWORK,DATA,ND5,KFILRA,RACESS,NUMRA,
3 FD1,ND2X3,NGRIDC,NGRID,ND11,
4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10,
5 NBLOCK,NFETCH,LASTL,LASTD,NSTORE,
6 IS0,IS1,IS2,IS4,ND7,
7 ISTAV,L3264B,L3264W,IER)
C
C COMPUTE LAMP MRMS AND TL PREDICTORS ON 10KM LC GRID.
C
ELSEIF((IDPARS(1).EQ.003.AND.IDPARS(2).EQ.200).OR.
1 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.203).OR.
2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR.
3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.805).OR.
4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR.
5 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.545).OR.
6 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.550).OR.
7 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.551).OR.
8 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.552).OR.
9 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.553)) THEN
CALL RATLGRD(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE,
1 CCALL,ICALLD,CCALLD,ISDATA,SDATA,DIR,ND1,NSTA,
2 IPACK,IWORK,DATA,ND5,
3 FD1,FD2,FD3,ND2X3,NGRIDC,NGRID,ND11,
4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10,
5 NBLOCK,NFETCH,LASTL,LASTD,NSTORE,
6 IS0,IS1,IS2,IS4,ND7,
7 ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR CONVERSION OF GRIDDED MOS FORECASTS FROM ONE
C UNIT TO ANOTHER. THIS ROUTINE DOES A HOST OF UNIT
C CONVERSIONS INCLUDING F-K, KTS-MPS, DEC-%, IN-M,
C IN-KG/M*2. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF((IDPARS(1).EQ.222.AND.((IDPARS(2).EQ.024).OR.
1 (IDPARS(2).EQ.034).OR.
2 (IDPARS(2).EQ.124).OR.
3 (IDPARS(2).EQ.134).OR.
4 (IDPARS(2).EQ.224).OR.
5 (IDPARS(2).EQ.234))).OR.
6 (IDPARS(1).EQ.223.AND.((IDPARS(2).EQ.024).OR.
7 (IDPARS(2).EQ.034).OR.
8 (IDPARS(2).EQ.254).OR.
9 (IDPARS(2).EQ.274).OR.
9 (IDPARS(2).EQ.354).OR.
9 (IDPARS(2).EQ.374).OR.
9 (IDPARS(2).EQ.384).OR.
A (IDPARS(2).EQ.044))).OR.
6 (IDPARS(1).EQ.224.AND.((IDPARS(2).EQ.374).OR.
+ (IDPARS(2).EQ.394))).OR.
B (IDPARS(1).EQ.227.AND.((IDPARS(2).EQ.124).OR.
C (IDPARS(2).EQ.224).OR.
D (IDPARS(2).EQ.234).OR.
E (IDPARS(2).EQ.334).OR.
F (IDPARS(2).EQ.434))).OR.
G (IDPARS(1).EQ.228.AND.((IDPARS(2).EQ.399).OR.
H (IDPARS(2).EQ.474).OR.
I (IDPARS(2).EQ.084).OR.
J (IDPARS(2).EQ.164))).OR.
K (IDPARS(1).EQ.722.AND.(IDPARS(2).EQ.034)).OR.
L (IDPARS(1).EQ.723.AND.(IDPARS(2).EQ.134)).OR.
M (IDPARS(1).EQ.728.AND.(IDPARS(2).EQ.004)).OR.
N (IDPARS(1).EQ.728.AND.(IDPARS(2).EQ.104)).OR.
O (IDPARS(1).EQ.728.AND.(IDPARS(2).EQ.309)).OR.
P (IDPARS(1).EQ.228.AND.(IDPARS(2).EQ.379)).OR.
Q (IDPARS(1).EQ.724.AND.(IDPARS(2).EQ.374)).OR.
R (IDPARS(1).EQ.724.AND.(IDPARS(2).EQ.394)).OR.
S (IDPARS(1).EQ.228.AND.(IDPARS(2).EQ.074)).OR.
T (IDPARS(1).EQ.228.AND.(IDPARS(2).EQ.134)))THEN
CALL GRDUNTCVT(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR COMPUTATION OF A CONSISTENCY CHECKED GRIDDED TEMP OR
C DEWPOINT. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF((IDPARS(1).EQ.222.AND.IDPARS(2).EQ.030).OR.
1 (IDPARS(1).EQ.223.AND.IDPARS(2).EQ.030)) THEN
CALL CKTMPDP(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR SHIFTED MAX/MIN/SNOW. THE PROJECTION IS MOVED BACK 6 HRS.
C THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202. IT IS NEEDED
C BECAUSE WE WANT TO PUT OUR MAX/MIN/SNOW INTO GRIB2 WITH MORE
C "NDFD-LIKE" PROJECTIONS.
C
ELSEIF((IDPARS(1).EQ.222.AND.((IDPARS(2).EQ.129).OR.
1 (IDPARS(2).EQ.229))).OR.
2 (IDPARS(1).EQ.228.AND.IDPARS(2).EQ.479)) THEN
CALL SHFTMXMN(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR COMPUTATION OF GRIDDED DEW POINT TEMP USING TEMPERATURE
C AND RH. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF(IDPARS(1).EQ.223.AND.IDPARS(2).EQ.040)THEN
CALL CMPDPGR(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR CONSTRAINING OF ANY GRIDDED FIELD BETWEEN TWO BOUNDS. THIS WAS
C ORIGINALLY WRITTEN TO CONSTRAIN RH BETWEEN 2 AND 100 BUT CAN BE EXPANDED.
C THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF((IDPARS(1).EQ.223.AND.(IDPARS(2).EQ.070.OR.
1 IDPARS(2).EQ.250)))THEN
CCCCC 2 IDPARS(2).EQ.350)))THEN
CALL CKBOUNDS(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR COMPUTATION OF GRIDDED RELATIVE HUMIDITY USING TEMP
C AND DEWPOINT. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF(IDPARS(1).EQ.223.AND.IDPARS(2).EQ.075)THEN
CALL CMPRHGR(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR COMPUTATION OF GRIDDED WIND DIRECTION USING U AND
C V WIND. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF(IDPARS(1).EQ.224.AND.IDPARS(2).EQ.250)THEN
CALL CMPWDRGR(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,FD3,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR CHECK THAT IN CALM WINDS, THE GRIDDED WIND SPEED IS
C SET TO ZERO. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF(IDPARS(1).EQ.224.AND.IDPARS(2).EQ.370)THEN
CALL CKWSPDGR(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR CHECK OF MAX WIND SPEED (WIND GUST) AGAINST GRIDDED
C WIND SPEED. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF(IDPARS(1).EQ.224.AND.IDPARS(2).EQ.390)THEN
CALL CKWNDGST(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR CHECK OF CONSISTENT AND BOUND 12-H GRIDDED POP AGAINST
C 6-H GRIDDED POPS. THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF(IDPARS(1).EQ.223.AND.IDPARS(2).EQ.350)THEN
CALL CKGPOP(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,FD3,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR COMPUTATION OF 12-HR GRIDDED PRECIP AMT. FROM THE
C CORRESPONDING 6-H GRIDDED PRECIP AMTS.
C THIS IS FOR GRIDDED DATA AND WAS WRITTEN FOR U202.
C
ELSEIF(IDPARS(1).EQ.223.AND.IDPARS(2).EQ.380)THEN
CALL CMPQPFGR(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,
2 KFILRA,RACESS,NUMRA,CCALL,ICALLD,
3 CCALLD,NAME,STALAT,STALON,
4 ISDATA,SDATA,DIR,ND1,NSTA,
5 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL,
7 NBLOCK,LASTD,NSTORE,NFETCH,
8 IS0,IS1,IS2,IS4,ND7,
9 FD1,FD2,ND2X3,IP12,
A ISTAV,L3264B,L3264W,IER)
C
C LOOK FOR COMPUTATION OF U- OR V-COMPONENT WINDS FROM
C VECTOR DATA
C
ELSEIF((IDPARS(1).EQ.204.OR.
1 IDPARS(1).EQ.704)
2 .AND.(IDPARS(2).EQ.010.OR.
3 IDPARS(2).EQ.110.OR.
4 IDPARS(2).EQ.102.OR.
5 IDPARS(2).EQ.122))THEN
CALL DIR2UV(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,IPACK,IWORK,FD1,FD2,ND2X3,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF MAX WIND SPEED IN 12-H
C
ELSEIF((IDPARS(1).EQ.704).AND.(IDPARS(2).EQ.420))THEN
CALL OBSMRWSP(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 CCALL,SDATA,ND1,NSTA,IPACK,IWORK,FD1,ND2X3,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF DAYTIME MAXIMUM TEMPERATURE
C FROM HOURLY TEMPERATURE AND EITHER 6 OR 12 HOUR
C MAXIMUM TEMPERATURE FROM VECTOR DATA. IT IS ASSUMED
C HOURLY TEMPERATURE AND 6/12 HOUR TEMPERATURES ARE
C BASIC VARIABLES.
C
ELSEIF((IDPARS(1).EQ.702).AND.(IDPARS(2).EQ.1))THEN
CALL OBSDMAXT(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 ITIMEZ,SDATA,ND1,NSTA,
2 CCALL,IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF NIGHTTIME MINIMUM TEMPERATURE
C FROM HOURLY TEMPERATURE AND EITHER 6 OR 12 HOUR
C MINIMUM TEMPERATURE FROM VECTOR DATA. IT IS ASSUMED
C HOURLY TEMPERATURE AND 6/12 HOUR TEMPERATURES
C ARE BASIC VARIABLES.
C
ELSEIF(IDPARS(1).EQ.702.AND.IDPARS(2).EQ.011)THEN
CALL OBSNMINT(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 ITIMEZ,SDATA,ND1,NSTA,
2 CCALL,IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF OBSERVED DEWPOINT DEPRESSION
C FROM TEMPERATURE AND DEWPOINT FROM VECTOR DATA
C
ELSEIF(IDPARS(1).EQ.703.AND.IDPARS(2).EQ.101)THEN
CALL OBSDPTD(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF CORRECTED DEW POINT
C
ELSEIF(IDPARS(1).EQ.703.AND.IDPARS(2).EQ.102)THEN
CALL CORDP(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF THE AVERAGE OF THE OBSERVED
C TEMPERATURE AND CORRECTED DEWPOINT FROM THE SURFACE
C STATION REPORTS.
C
ELSEIF(IDPARS(1).EQ.703.AND.IDPARS(2).EQ.103)THEN
CALL OBSTWET(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,FD3,FD4,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF 12,18, OR 24H PCPN AMOUNT
C USING 6HR AMOUNTS FROM VECTOR OBSERVATIONAL DATA
C
ELSEIF(IDPARS(1).EQ.703.AND.(IDPARS(2).EQ.220.OR.
1 IDPARS(2).EQ.230.OR.
2 IDPARS(2).EQ.240.OR.
3 IDPARS(2).EQ.212.OR.
4 IDPARS(2).EQ.222.OR.
5 IDPARS(2).EQ.232.OR.
6 IDPARS(2).EQ.242))THEN
CALL PCPX6(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF 24-HR PROBABILITY OF PRECIPITATION
C BASED ON THE NCDC COOPERATIVE OBSERVER DATA
C
ELSEIF((IDPARS(1).EQ.703).AND.(IDPARS(2).EQ.327))THEN
CALL OBSCPPRCP(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 CCALL,SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF THUNDERSTORM, SEVERE LOCAL STORM,
C CAT, AND AIRCRAFT ICING PREDICTAND VARIABLES FOR SPECIFIC
C HOURLY PERIODS (3, 6, 12, AND/OR 24-HR) FROM VECTOR DATA.
C
ELSEIF((IDPARS(1).EQ.707).AND.
1 ((IDPARS(2).GE.200).AND.(IDPARS(2).LE.424)))THEN
CALL SVRVEC(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,DATA,FD1,FD2,FD3,FD4,FD5,FD6,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF THE INTERACTIVE PREDICTOR KF
C FROM VECTOR DATA. THIS _OLD VERSION USES THE OLD RF
C ID SCHEME AND IS USED FOR THE 48 AND 20KM TSTMS. THE
C NEW VERSION BELOW USES THE NEW RF ID SCHEME AND IS
C USED IN THE 40KM TSTMS.
C
ELSEIF(IDPARS(1).EQ.007.AND.(IDPARS(2).EQ.460.OR.
1 IDPARS(2).EQ.465.OR.
2 IDPARS(2).EQ.470.OR.
3 IDPARS(2).EQ.475.OR.
4 IDPARS(2).EQ.480.OR.
5 IDPARS(2).EQ.485.OR.
6 IDPARS(2).EQ.490))THEN
CALL KINXRF_OLD(KFILDO,KFIL10,IP12,IP16,IDPARS,JD,NDATE,
1 KFILRA,RACESS,NUMRA,
2 CCALL,ICALLD,CCALLD,
3 ISDATA,SDATA,DIR,ND1,NSTA,
4 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
5 LSTORE,ND9,LITEMS,CORE,ND10,
6 LASTL,NBLOCK,LASTD,NSTORE,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,
8 FD1,FD2,FD3,FD5,FD6,FD4,ND2X3,
9 ISTAV,L3264B,L3264W,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF THE INTERACTIVE PREDICTOR KF
C FROM VECTOR DATA
C
ELSEIF(IDPARS(1).EQ.007.AND.(IDPARS(2).EQ.461.OR.
1 IDPARS(2).EQ.466.OR.
2 IDPARS(2).EQ.471.OR.
3 IDPARS(2).EQ.476.OR.
4 IDPARS(2).EQ.481.OR.
5 IDPARS(2).EQ.486.OR.
6 IDPARS(2).EQ.491))THEN
CALL KINXRF(KFILDO,KFIL10,IP12,IP16,IDPARS,JD,NDATE,
1 KFILRA,RACESS,NUMRA,
2 CCALL,ICALLD,CCALLD,
3 ISDATA,SDATA,DIR,ND1,NSTA,
4 NGRIDC,ND11,NSLAB,IPACK,IWORK,DATA,ND5,
5 LSTORE,ND9,LITEMS,CORE,ND10,
6 LASTL,NBLOCK,LASTD,NSTORE,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,
8 FD1,FD2,FD3,FD5,FD6,FD4,ND2X3,
9 ISTAV,L3264B,L3264W,MISTOT,IER)
C
C COMPUTE THE PREDICTAND FOR THE OBSTRUCTION TO VISION
C FOR THE CURRENT HOUR; THIS VARIABLE IS COMPUTED FROM
C THE PRESENT WX GROUPS OF THE HOURLY REPORTS; THE VALUES
C ARE 1 FOR NO OBVIS, 2 FOR H, 3 FOR BR, 4 FOR FG, AND 5 FOR
C BLOWING PHENOMENON.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.251)THEN
CALL OBSOBVIS(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,IPACK,IWORK,FD1,FD2,ND2X3,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF TOTAL CLOUD AMOUNT FROM HOURLY
C CLOUD AMOUNT. THIS COMPUTATION IS DONE COMPLETELY
C FROM THE SURFACE STATION REPORTS AND IS NOT COMPLEMENTED WITH SCP
C CLOUD AMOUNT. IT IS ASSUMED CLOUD AMOUNT IS A BASIC VARIABLE.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.311)THEN
CALL SFCTCLD(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 ISDATA,SDATA,ND1,NSTA,IPACK,IWORK,FD1,ND2X3,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF TOTAL CLOUD AMOUNT FROM HOURLY
C CLOUD AMOUNT COMPLEMENTED IF NECESSARY WITH SCP
C CLOUD AMOUNT. IT IS ASSUMED CLOUD AMOUNT, STATION TYPE,
C AND BOTH EAST AND WEST SCP CLOUD AMOUNTS ARE BASIC
C VARIABLES.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.312)THEN
CALL OBSTCLD(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 CCALL,STALAT,STALON,ISDATA,SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,FD3,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF EXTENDED-RANGE MEAN SKY
C COVER COMPUTED FROM THE HOURLY SKY COVER OBSERVATIONS
C AS WELL AS THE SCP OBSERVATIONS.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.315) THEN
CALL OBSMRCLD(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 CCALL,STALAT,STALON,ISDATA,SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,FD3,FD4,FD5,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF CONDITIONAL AND UNCONDITIONAL
C 24-HR SNOWFALL AMOUNT BASED ON THE NCDC COOPERATIVE
C OBSERVER DATA
C
ELSEIF((IDPARS(1).EQ.708).AND.(IDPARS(2).EQ.427.OR.
1 IDPARS(2).EQ.417))THEN
CALL OBSCPSNOW(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 CCALL,SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF 24-HR CONDITIONAL
C PROBABILITY OF SNOW BASED ON THE NCDC COOPERATIVE
C OBSERVER DATA
C
ELSEIF((IDPARS(1).EQ.708).AND.(IDPARS(2).EQ.507))THEN
CALL OBSCPCPOS(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 CCALL,SDATA,ND1,NSTA,
2 IPACK,IWORK,ND5,
3 FD1,FD2,ND2X3,
4 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
5 IS0,IS1,IS2,IS4,ND7,
6 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF OBSERVED PRECIPITATION TYPE (FREEZING
C RAIN, SNOW, LIQUID) FROM THE SURFACE STATION REPORTS.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.501)THEN
CALL OBSPTYPE(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,IPACK,IWORK,FD1,ND2X3,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF OBSERVED PRECIPITATION TYPE (FREEZING,
C PURE SNOW, SNOW AND RAIN MIXED, PURE RAIN) OVER A 12-H
C PERIOD. THIS OBSERVATION IS USED AS A PREDICTAND FOR THE
C EXTENDED-RANGE GUIDANCE.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.511)THEN
CALL OBSMRPTYPE(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF OBSERVED PRECIPITATION TYPE (FREEZING
C RAIN, SNOW, LIQUID OR NO REPORT) BINARY FROM THE SURFACE
C STATION REPORTS.
C
ELSEIF(IDPARS(1).EQ.708.AND.(IDPARS(2).EQ.551).OR.
1 (IDPARS(2).EQ.552).OR.
2 (IDPARS(2).EQ.553))THEN
CALL OBSPRWXBIN(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C COMPUTE THE PREDICTAND FOR THE OCCURRENCE OF PRECIPITATION
C FOR THE CURRENT HOUR; IF THERE IS A REPORT OF PRECIP.
C IN THE HOURLY REPORT, THEN THE PREDICTAND IS SET
C TO 1; OTHERWISE, IT IS SET TO 0.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.504)THEN
CALL OBSPOPO(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C (UNCOMMENTED FOR OPERATIONS 7/2002 - OBSPOPO3 FIXED)
C (COMMENTED OUT FOR OPERATIONS 9/7/00 - NOT WORKING YET)
C COMPUTE THE PREDICTAND FOR THE OCCURRENCE OF PRECIPITATION
C DURING THE LAST 3 HOURS; IF THERE IS A REPORT OF PRECIP.
C IN ANY OF THE HOURLY REPORTS, THEN THE PREDICTAND IS SET
C TO 1; OTHERWISE, IT IS SET TO 0.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.564)THEN
CALL OBSPOPO3(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF OBSERVED PRECIPITATION CHARACTERISTIC
C (DRIZZLE, STEADY, SHOWERY) FROM THE SURFACE STATION REPORTS.
C CODED VALUES: 1-DRIZZLE; 2-STEADY; 3-SHOWERY)
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.605)THEN
CALL OBSPOPC(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF CEILING HEIGHT FROM CLOUD
C HEIGHT AND CLOUD COVER FROM VECTOR DATA. IT IS ASSUMED
C CLOUD HEIGHT AND CLOUD COVER ARE BASIC VARIABLES.
C
ELSEIF(IDPARS(1).EQ.708.AND.IDPARS(2).EQ.0)THEN
CALL OBSCIGHT(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,
4 NBLOCK,NFETCH,
5 IS0,IS1,IS2,IS4,ND7,
6 ISTAV,L3264B,IER)
C
C LOOK FOR COMPUTATION OF 12 OR 24H SNOWFALL AMOUNT
C USING 6HR AMOUNTS FROM VECTOR OBSERVATIONAL DATA
C
ELSEIF(IDPARS(1).EQ.708.AND.(IDPARS(2).EQ.402.OR.
1 IDPARS(2).EQ.405))THEN
CALL SNOWFL(KFILDO,KFIL10,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,
2 IPACK,IWORK,FD1,FD2,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
4 IS0,IS1,IS2,IS4,ND7,
5 ISTAV,L3264B,IER)
C
C LOOK FOR GRID FIELD NOT FROM LAMP WITH A TAU NOT EVENLY
C DIVISIBLE BY 3. IT IS ASSUMED MODEL NCEP FORECASTS ARE
C AT 3-HR INCREMENTS (STARTING AT 0). THE VARIABLE IS
C ACCOMMODATED ONLY FOR CCC = 00X, MOD(IDPARS(12),3) NE 0,
C AND DD NE 5. LAMP MODEL FORECASTS EXIST AT EVERY HOUR.
C
ELSEIF(IDPARS(1)/10.EQ.0.AND.MOD(IDPARS(12),3).NE.0.AND.
1 IDPARS(4).NE.5)THEN
CALL TIMGRD(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,
1 SDATA,ND1,NSTA,NSLAB,IPACK,IWORK,DATA,ND5,
2 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK,NFETCH,
3 IS0,IS1,IS2,IS4,ND7,
4 FD1,FD2,ND2X3,
5 ISTAV,L3264B,MISTOT,IER)
C
C LOOK FOR COMPUTATION OF SIN AND COS OF DAY OF YEAR
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 SDATA,NSTA,ISTAV,IER)
C
C THE BELOW IS A TEST PROGRAM. WHEN ALL ELSE ABOVE
C FAILS, WHEN THE LAST DIGIT IN FFF = 9, CALL AVHRLY.
C
ELSEIF(MOD(IDPARS(2),10).EQ.9)THEN
CALL AVHRLY(KFILDO,KFIL10,
1 ID,IDPARS,JD,NDATE,SDATA,ND1,NSTA,
2 IPACK,IWORK,DATA,ND2X3,
3 LSTORE,ND9,LITEMS,CORE,ND10,
4 NBLOCK,NFETCH,
5 IS0,IS1,IS2,IS4,ND7,
6 ISTAV,L3264B,IER)
C
ELSE
IER=-3
C IER SET -3 HERE TO DISTINGUISH IT FROM
C IER = -2 FROM OPTN2 FROM A SUBROUTINE.
ENDIF
C
IF(IER.EQ.0)THEN
C GOOD RETURN, GOOD DATA.
GO TO 200
C
ELSEIF(IER.EQ.47)THEN
C ID IDENTIFIED, BUT DATA NOT AVAILABLE FROM
C A SUBROUTINE. OPTN2 WILL HAVE PRINTED
C A DIAGNOSTIC ONLY IF THE ID COULD NOT BE FOUND.
WRITE(KFILDO,199)(ID(J),J=1,4),NDATE,IER
GO TO 200
C
ELSEIF(IER.EQ.120)THEN
C ID IDENTIFIED, GOOD DATA FROM CONST. IER = 120
C JUST MEANS SOME STATIONS COULD NOT BE FOUND IN
C THE CONSTANT FILE.
GO TO 200
C
ELSEIF(IER.EQ.-2)THEN
C AT THIS POINT, IER = -2 IS FROM OPTN2 FROM A
C SUBROUTINE. THE ID WAS FOUND IN OPTION. JUST
C SET IER = 47 TO INDICATE MISSING DATA. A
C DIAGNOSTIC WAS PRINTED IN OPTN2, SO DON'T DO
C ONE HERE.
IER=47
GO TO 200
C
ELSEIF(IER.EQ.-3)THEN
C IER = -3 SHOULD MEAN THE ID WAS NOT FOUND IN OPTION.
C SET IT TO -2. (IT IS POSSIBLE THAT A SUBROUTINE
C CALLED OPTION INSTEAD OF OPTN2 AND IER = -3 CAME
C FROM THAT CALL. IN THIS CASE, IER = -2 WILL
C RESULT WHEN IT SHOULD HAVE BEEN 47. THIS
C SHOULD ONLY RESULT WHEN DATA WERE NOT AVAILABLE
C FOR DAY 1.) ONLY WHEN THE ID WAS NOT FOUND IN
C OPTION IS ISTAV SET.
IER=-2
ISTAV=1
C
IF(IDPARS(1).NE.799)THEN
C IN CASE OPTION IS ENTERED WITH THE DUMMY
C IDPARS(1) = 799, THE DIAGNOSTIC IS NOT PRINTED.
WRITE(KFILDO,198)(ID(J),J=1,4),NDATE,IER
198 FORMAT(/' ****VARIABLE NOT IDENTIFIED ',
1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3,
2 ' IN OPTION FOR DATE',I11,', IER = ',I4)
ENDIF
C
GO TO 200
C
ELSE
WRITE(KFILDO,199)(ID(J),J=1,4),NDATE,IER
199 FORMAT(/' ****TROUBLE COMPUTING VARIABLE ',
1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3,
2 ' IN OPTION FOR DATE',I11,', IER = ',I4)
C ANY VALUE OF IER OTHER THAN THE ONES ABOVE
C IS FROM A SUBROUTINE AND SHOULD BE RETAINED,
C ESPECIALLY -1 WHICH MEANS THE DATA SHOULD NOT
C BE WRITTEN.
ENDIF
C
200 CONTINUE
C
C WRITE(KFILDO,210)IER,(SDATA(J),J=1,6)
C210 FORMAT(/' RETURNING FROM OPTION, IER ='I5/(' '10F10.2))
RETURN
END