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 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.03).AND. 1 ((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR. 2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.011).OR. 3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR. 4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.101).OR. 5 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.651).OR. 6 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.355).OR. 7 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.202).OR. 8 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.203).OR. 9 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.231).OR. x (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.031).OR. 1 (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.131).OR. 2 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.501))) THEN C CALL RAPGRDAK(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 COMPUTE LAMP MRMS AND TL PREDICTORS ON 10KM NPS GRID (AK) C ELSEIF((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR. 5 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.545).OR. 6 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.550)) THEN CALL RATLGRDAK(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE, 2 IPACK,IWORK,DATA,ND5,KFILRA,RACESS, 3 FD1,ND2X3,ND11, 4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,L3264B,L3264W,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 ELSEIF((MOD(IDPARS(12),3).NE.0).AND.((IDPARS(1)/100).EQ.2.OR. 1 (IDPARS(1)/10.EQ.0.AND.IDPARS(4).NE.5)))THEN CALL TIMTRP(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 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 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 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 c ELSEIF((IDPARS(4).EQ.03).AND. c 1 ((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR. c 1 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.011).OR. c 2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR. c 3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.101).OR. c 4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.651).OR. c 5 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.355).OR. c 6 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.202).OR. c 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 c CALL HRRRGRD(KFILDO,KFIL10,ID,IDPARS,NDATE,IPACK, c 1 IWORK,DATA,NSLAB,ND5, c 1 IWORK,DATA,NSLAB,ND5,ND1,NGRID,CCALL,NSTA,DIR, c 2 FD1,FD2,FD3,FD4,FD5,FD6,FDSINS,FDMS,ND2X3, c 3 NGRIDC,ND11,LSTORE,ND9,LITEMS,CORE,ND10, c 4 NBLOCK,NFETCH,IS0,IS1,IS2,IS4,ND7, c 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 c ELSEIF((IDPARS(4).EQ.03).AND. c 1 ((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR. c 2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.011).OR. c 3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR. c 4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.101).OR. c 5 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.651).OR. c 6 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.355).OR. c 7 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.202).OR. c 8 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.203).OR. c 9 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.231).OR. c x (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.031).OR. c 1 (IDPARS(1).EQ.004.AND.IDPARS(2).EQ.131).OR. c 2 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.501))) THEN C c CALL RAPGRDAK(KFILDO,KFIL10,ID,IDPARS,NDATE,IPACK, c 1 IWORK,DATA,NSLAB,ND5,ND1,NGRID,CCALL,NSTA,DIR, c 2 FD1,FD2,FD3,FD4,FD5,FD6,FDSINS,FDMS,ND2X3, c 3 NGRIDC,ND11,LSTORE,ND9,LITEMS,CORE,ND10, c 4 NBLOCK,NFETCH,IS0,IS1,IS2,IS4,ND7, c 5 ISTAV,L3264B,L3264W,IER) C C COMPUTE LAMP MRMS AND TL PREDICTORS ON 10KM NPS GRID (AK) C c ELSEIF((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR. c 5 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.545).OR. c 6 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.550)) THEN c CALL RATLGRDAK(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE, c 2 IPACK,IWORK,DATA,ND5,KFILRA,RACESS, c 3 FD1,ND2X3,ND11, c 4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10, c 5 NBLOCK,NFETCH, c 6 IS0,IS1,IS2,IS4,ND7, c 7 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 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, 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 c ELSEIF((IDPARS(1).EQ.003.AND.IDPARS(2).EQ.200).OR. c 1 (IDPARS(1).EQ.003.AND.IDPARS(2).EQ.203).OR. c 2 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR. c 3 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.805).OR. c 4 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.811).OR. c 5 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.545).OR. c 6 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.550).OR. c 7 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.551).OR. c 8 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.552).OR. c 9 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.553)) THEN c CALL RATLGRD(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE, c 2 IPACK,IWORK,DATA,ND5,KFILRA,RACESS, c 3 FD1,ND2X3,ND11, c 4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10, c 5 NBLOCK,NFETCH, c 6 IS0,IS1,IS2,IS4,ND7, c 7 ISTAV,L3264B,L3264W,IER) C C COMPUTE LAMP MRMS AND TL PREDICTORS ON 10KM NPS GRID (AK) C c ELSEIF((IDPARS(1).EQ.007.AND.IDPARS(2).EQ.801).OR. c 5 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.545).OR. c 6 (IDPARS(1).EQ.007.AND.IDPARS(2).EQ.550)) THEN c CALL RATLGRDAK(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE, c 2 IPACK,IWORK,DATA,ND5,KFILRA,RACESS, c 3 FD1,ND2X3,ND11, c 4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10, c 5 NBLOCK,NFETCH, c 6 IS0,IS1,IS2,IS4,ND7, c 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