SUBROUTINE OPTX_ARCHIVE(KFILDO,KFILRA,NUMRA,IP12,ID,IDPARS, 1 JD,NDATE,CCALL,XDATA,ND1,NSTA,ND5, 2 IS0,IS1,IS2,IS4,ND7,IOPT,ISTAB,IER) C$$$ SUBPROGRAM DOCUMENTATION BLOCK *** C C SUBPROGRAM: OPTX_ARCHIVE C PRGMMR: MALONEY ORG: W/OST22 DATE: 2001-01-15 C C ABSTRACT: TO PROVIDE ACCESS TO THE MOS-2000 RANDOM ACCESS FILES BY C CALLING READ_MOSDA. IF NECESSARY, ALSO PROVIDE ACCESS TO SUBROUTINE C CHNGID IF AN ID NEEDS TO BE CHANGED FROM WHAT IS PRESENT IN THE C INPUT FILE. C C PROGRAM HISTORY LOG: C 00-06-01 GLAHN C 01-01-15 MALONEY ADDED CALL TO CHNGID; REMOVED CALLS TO FTOKEL, C MPSKTS, KTSMPS, FORIER WHICH ARE NOT NEEDED C 01-02-01 MALONEY SET ISTAB=1 TO AVOID BINFUL FOR PROBABILITIES C ALREADY CALCULATED IN THE INPUT FILE C 01-03-01 MALONEY ADDED NCEP DOCBLOCK C 01-03-21 MALONEY CHANGED CALL TO CONST TO READ_MOSDA C 01-03-29 MALONEY REWROTE LOGIC TO INCLUDE IOPT, CLEANED UP CALL C 01-05-09 MALONEY ADDED NUMRA TO CALL FOR MULTIPLE R.ACCESS FILES C C USAGE: CALLED BY VRBL66 C C DATA SET USE C INPUT FILES: C FORT.XX - INDICATE NAME AND PURPOSE C KFILRA - UNIT NUMBERS FOR THE MOS-2000 EXTERNAL RANDOM C ACCESS FILES (J=1,NUMRA) C C OUTPUT FILES: (INCLUDING WORK FILES) C FORT.XX - INDICATE NAME AND PURPOSE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C C VARIABLES: C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C KFILRA(J) = THE UNIT NUMBERS FOR THE MOS-2000 EXTERNAL C RANDOM ACCESS FILES (J=1,NUMRA) C NUMRA = THE NUMBER OF RANDOM ACCESS FILES AVAILABLE C IP12 = INDICATES WHETHER (>0) OR NOT (=0) THE LIST OF C STATIONS ON THE EXTERNAL RANDOM ACCESS FILES C WILL BE LISTED TO UNIT IP12. (INPUT) C ID(J) = THE VARIABLE ID (J=1,4). (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE C ID CORRESPONDING TO ID( ) (J=1,15). (INPUT) C J=1--CCC (CLASS OF VARIABLE), C J=2--FFF (SUBCLASS OF VARIABLE), C J=3--B (BINARY INDICATOR), C J=4--DD (DATA SOURCE, MODEL NUMBER), C J=5--V (VERTICAL APPLICATION), C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK IN TIME), C J=10--OT (TIME APPLICATION), C J=11--OH (TIME PERIOD IN HOURS), C J=12--TAU (PROJECTION IN HOURS), C J=13--I (INTERPOLATION TYPE), C J=14--S (SMOOTHING INDICATOR), AND C J=15--G (GRID INDICATOR). C JD(J) = THE BASIC INTEGER VARIABLE ID (J=1,4). C THIS IS THE SAME AS ID(J), EXCEPT THAT THE FOLLOWING C PORTIONS ARE OMITTED: C B = IDPARS(3), C G = IDPARS(15), AND C THRESH. C JD( ) IS USED TO IDENTIFY WHICH CALCULATIONS C CAM BE MADE DIRECTLY IN U600. (INPUT) C NDATE = THE DATE/TIME FOR WHICH VARIABLE IS NEEDED. (INPUT) C CCALL(K,J) = 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT C LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE C OUTPUT FOR (J=1) AND 5 POSSIBLE OTHER STATION C CALL LETTERS (J=2,6) THAT CAN BE USED INSTEAD C IF THE PRIMARY (J=1) STATION CANNOT BE FOUND C IN AN INPUT DIRECTORY (K=1,NSTA). ALL STATION C DATA ARE KEYED TO THIS LIST. (CHARACTER*8) C (INPUT) C XDATA(K) = DATA TO RETURN (K=1,NSTA). (OUTPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH. C (INPUT) C NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT WITH. C (INPUT) C ND5 = DIMENSION OF IPACK( ), WORK( ), DATA( ), AND C CALLD( ), AND SECOND DIMENSION OF ICALLD( , ). C (INPUT) 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 IOPT = INDICATES WHAT PROCESSING (IF ANY) IS TO BE DONE C IN CHNGID. (INPUT) C ISTAB = USUALLY ZERO, BUT SET TO ONE IN CERTAIN C SUBROUTINES. (OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 99 = VARIABLE NOT DEFINED IN OPTX. C SEE CALLED ROUTINES FOR OTHER VALUES. C (INTERNAL-OUTPUT) C INDEX(K,L) = ARRAY CONTAINING LOCATION OF STATION K IN FILE C DIRECTORY L, WHERE K=1,NSTA AND L=1,15. C (INTERNAL) C C SUBPROGRAMS CALLED: C UNIQUE: - CHNGID C LIBRARY: C MDLLIB90: - READ_MOSDA C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C 99 - VARIABLE NOT DEFINED IN OPTX (NON-FATAL) C 120 - DATA FOUND, BUT A STATION MISSING IN THE DIRECTORY C (NON-FATAL) C C REMARKS: NONE C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 (xlf compiler) C MACHINE: IBM SP C C$$$ C CHARACTER*8 CCALL(ND1,6) C DIMENSION XDATA(ND1) DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION INDEX(ND1,15) DIMENSION KFILRA(5) C IER=0 C ISTAB IS SET TO 1 HERE! THIS IS TO AVOID BINFUL IN VRBL66. C DONE BY MALONEY PER REQUEST OF DALLAVALLE. IN THE FULL VERSION C OF OPTX, BINARIES ARE CALCULATED AND ISTAB IS CHANGED FROM 1 TO C 0. HOWEVER, HERE WE ARE DOING NO CALCULATION, SO ISTAB WOULD C NEVER GET CHANGED FROM 0, AND SOME DATA WOULD GET CORRUPTED. ISTAB=1 C C CHANGE CERTAIN IDS TO NEW IDS. USED TO ALLEVIATE C CONFUSION BETWEEN BINARY VARIABLES AND SIMILAR C NON-BINARY VARIABLES. C IF(IOPT.NE.0) THEN CALL CHNGID(KFILDO,KFILRA,NUMRA,IP12, 1 ID,IDPARS,JD, 2 NDATE,CCALL,XDATA,ND1,NSTA, 3 ND5,IS0,IS1,IS2,IS4,ND7,IOPT, 4 INDEX,IER) C IF(IER.EQ.0.OR. 1 IER.EQ.120) GO TO 300 C C LOOK FOR CONSTANT DATA, TO BE PROVIDED IN THE C MOS-2000 EXTERNAL RANDOM ACCESS FILES. NOTE THAT C NDATE (NOT MDATE) IS USED BECAUSE THE TAU IN THE ID C IS USED WITH NDATE TO GET THE DATE/TIME OF THE C DATA WANTED. C ELSE IF((IDPARS(1).GE.400.AND.IDPARS(1).LE.699).OR. 1 (IDPARS(1).GE.800.AND.IDPARS(1).LE.899).OR. 2 (IDPARS(1).GE.200.AND.IDPARS(1).LE.299))THEN DO 190 N=1,NUMRA CALL READ_MOSDA(KFILDO,KFILRA(N),IP12, 1 ID,NDATE,CCALL,NSTA, 2 XDATA,ND1,ND5,ND7,IS0,IS1, 3 IS2,IS4,INDEX,IER) C IF(IER.EQ.0.OR. 1 IER.EQ.120)GO TO 300 C 190 CONTINUE ELSE IER=99 ENDIF C IF(IER.EQ.99)THEN WRITE(KFILDO,198)(ID(J),J=1,4),NDATE 198 FORMAT(/,' ****VRBL NOT IDENTIFIED IN OPTX ', 1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3,' FOR DATE ',I11,'.') ELSE WRITE(KFILDO,1980)(ID(J),J=1,4),NDATE 1980 FORMAT(/,' ****VRBL NOT COMPUTED IN OPTX ', 1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3,' FOR DATE ',I11,'.') ENDIF C DO 200 K=1,NSTA XDATA(K)=9999. 200 CONTINUE C 300 RETURN END