SUBROUTINE OPT755(KFILDO,KFIL10, 1 ID,IDPARS,THRESH,JD,NDATE, 2 KFILRA,RACESS,NUMRA,CCALL,ICALLD, 3 CCALLD, 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,FD5, A ND2X3,IP12,IP16, B ISTAV,L3264B,L3264W,MISTOT,IER) C C JULY 2018 GLAHN TDL MOS-2000 C ADAPTED FROM OPTION C C PURPOSE C TO CALL VARIOUS COMPUTATIONAL ROUTINES FOR U755. C C THE CALL SEQUENCE IS COMPOSED OF THOSE ELEMENTS IN OPTION C THAT ARE ALSO IN THE CALLING PROGRAM MELD70. 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 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 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 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 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 MSTORE( , ). C LATER USED AS A WAY OF DETERMINING WHETHER C TO KEEP THIS VARIABLE. C ND9 = THE SECOND DIMENSION OF LSTORE( , ). (INPUT) C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , ) THAT C HAVE BEEN USED IN THIS RUN. (INPUT/OUTPUT) C CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA IDENTIFIED IN C LSTORE( , ) (J=1,ND10). WHEN CORE( ) IS FULL C DATA ARE STORED ON DISK. (INPUT/OUTPUT) C ND10 = DIMENSION OF CORE( ). (INPUT) C LASTL = THE LAST LOCATION IN CORE( ) USED 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 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 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 OPT755. C 47 = DATA NOT FOUND C (INTERNAL-OUTPUT) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C HRRLG1 C CHARACTER*8 CCALL(ND1,6), 1 CCALLD(ND5) CHARACTER*60 RACESS(NUMRA) C DIMENSION ICALL(L3264W,ND1,6), 1 ISDATA(ND1),SDATA(ND1) DIMENSION DIR(ND1,2,ND11),NGRIDC(6,ND11) DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5),ICALLD(L3264W,ND5) DIMENSION FD2(ND2X3),FD3(ND2X3),FD4(ND2X3),FD5(ND2X3) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION KFILRA(NUMRA) C CALL TIMPR(KFILDO,KFILDO,'START OPT755 ') C D WRITE(KFILDO,100)(ID(J),J=1,4),(JD(J),J=1,4),(IDPARS(J),J=1,15) D100 FORMAT(' IN OPT755--(ID(J),J=1,4),(JD(J),J=1,4),', D 1 '(IDPARS(J),J=1,15)',/,' ',4I10,/,' ',4I10,15I5) C IER=0 C C LOOK FOR HRRR CIG OR VIS LAGGED VARIABLES. C IF(IDPARS(1).EQ.000.AND.IDPARS(2).EQ.999)THEN C THIS IS A DUMMY. ROUTINES CAN BE PUT IN AS NEEDED. C CCC IF(IDPARS(1).EQ.008.AND.IDPARS(2).EQ.025)THEN CCC CALL HRRLG1(KFILDO,KFIL10, CCC 1 ID,IDPARS,JD,THRESH,NDATE, CCC 2 IPACK,IWORK,DATA,ND1, CCC 3 LSTORE,ND9,LITEMS,CORE,ND10, CCC 4 NBLOCK,NFETCH,NSLAB, CCC 5 IS0,IS1,IS2,IS4,ND7, CCC 6 ISTAV,L3264B,IER) ELSE IER=-2 ENDIF C IF(IER.EQ.0)THEN C GOOD RETURN, GOOD DATA. GO TO 200 C ELSEIF(IER.EQ.47)THEN C ID IDENTIFIED IN OPT755, BUT DATA NOT AVAILABLE FROM C A SUBROUTINE. WRITE(KFILDO,189)(ID(J),J=1,4),NDATE,IER C ELSEIF(IER.EQ.-2)THEN WRITE(KFILDO,188)(ID(J),J=1,4),NDATE,IER 188 FORMAT(/' ****VARIABLE NOT IDENTIFIED ', 1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 2 ' IN OPT755 FOR DATE',I11,', IER = ',I4) C ELSE WRITE(KFILDO,189)(ID(J),J=1,4),NDATE,IER 189 FORMAT(/' ****TROUBLE COMPUTING VARIABLE ', 1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 2 ' IN OPT755 FOR DATE',I11,', IER = ',I4) C ANY VALUE OF IER OTHER THAN THE ONES ABOVE C IS FROM A SUBROUTINE AND SHOULD BE RETAINED. ENDIF C DO 199 J=1,ND5 DATA(J)=9999. 199 CONTINUE C 200 CONTINUE C IF(ISTAV.EQ.0)THEN WRITE(KFILDO,210)IER,(DATA(J),J=1,6) 210 FORMAT(/' RETURNING GRIDPOINT DATA FROM OPT755, IER =',I5/ 1 (' FIRST 6 VALUES',10F10.2)) ELSE WRITE(KFILDO,211)IER,(SDATA(J),J=1,6) 211 FORMAT(/' RETURNING VECTOR DATA FROM OPT755, IER =',I5/ 1 (' ',10F10.2)) ENDIF C CALL TIMPR(KFILDO,KFILDO,'END OPT755 ') RETURN END