SUBROUTINE VRBL66(KFILDO,KFILRA,NUMRA, 1 ID,IDPARS,JD,NWHERE,NVRBL, 2 NDATE,CCALL,XDATA,ND1, 3 AA,NSTA,DATA,ND5, 4 IS0,IS1,IS2,IS4,ND7, 5 IP12,ISTOP,IER) C$$$ SUBPROGRAM DOCUMENTATION BLOCK *** C C SUBPROGRAM: VRBL66 C PRGMMR: GLAHN ORG: W/OST22 DATE: 1996-01-01 C C ABSTRACT: TO OBTAIN FOR U660 ALL VARIABLES IDENTIFIED IN ID( , ), C AND IDPARS( , ). "BASIC" VARIABLES (THE VARIABLES SANS PROCESSING C INFORMATION) ARE IDENTIFIED IN JD( , ), RESPECTIVELY. VARIABLES C ARE OBTAINED THROUGH CALLING SUBROUTINE OPTX_MERGE. C C PROGRAM HISTORY LOG: C 98-01-01 GLAHN C 01-03-02 MALONEY ADDED NCEP DOCBLOCK, W3TAGE CALL C 01-03-29 MALONEY EDITED CALL TO OPTX_ARCHIVE C 01-04-03 MALONEY CLEANED OUT CODE C 01-05-09 MALONEY RE-ADDED NUMRA TO CALL TO OPTX_ARCHIVE C 05-02-28 DALLAVALLE ELIMINATED CALL TO OPTX_ARCHIVE; ADDED C CALL TO READ_MOSDA SO AS TO OBTAIN C VECTOR DATA DIRECTLY FROM THE RANDOM C ACCESS FILES. C C USAGE: CALL VRBL66(KFILDO,KFILRA,NUMRA,ID,IDPARS,JD,NWHERE, C NVRBL,NDATE,CCALL,XDATA,ND1,AA,NSTA,ND5, C IS0,IS1,IS2,IS4,ND7,IP12,ISTOP,IER) C INPUT ARGUMENT LIST: C C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILRA(J) = UNIT NUMBERS FOR READING MOS-2000 EXTERNAL C RANDOM ACCESS FILES (J=1,NUMRA). (INPUT) C NUMRA = NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (INPUT) C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NVRBL). C (INPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE C ID CORRESPONDING TO ID( ) (J=1,15) (N=1,NVRBL). C (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). HAS NO MEANING EXCEPT IN C U201. C JD(J,N) = THE BASIC INTEGER VARIABLE ID (J=1,4) (N=1,NVRBL). C THIS IS THE SAME AS ID(J,N), EXCEPT THAT SOME PORTIONS C ARE OMITTED: C B = IDPARS(3, ), C G = IDPARS(15, ), AND C TRESHL( ). C JD( , ) IS USED TO IDENTIFY WHICH CALCULATIONS C CAN BE MADE DIRECTLY IN U600, WHICH IS ONLY FORMING C BINARIES. THE "G" VARIABLE HAS NO MEANING IN U660, C IT BEING ONLY FOR POSSIBLE USE IN U201. C (INPUT) C NVRBL = THE NUMBER OF VARIABLES NEEDED AND IDENTIFIED IN C ID( , ), ETC. ALSO TREATED AS THE DIMENSION OF THE C VARIABLES ID( , ), ETC. (INPUT) C NDATE = THE DATE/TIME FOR WHICH VARIABLES ARE TO BE C FURNISHED ON THIS CALL TO VRBL66. (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/OUTPUT) C XDATA(K) = THE DATA FOR THE NSTA STATIONS BEING PROCESSED C (K=1,NSTA). (INTERNAL) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH. C DIMENSION OF SEVERAL ARRAYS. (INPUT) C NSTA = THE NUMBER OF STATIONS IN CCALL( , ). (INPUT) C ND5 = PASSED TO OPTX_MERGE AND THEN TO READ_MOSDA. 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 IP12 = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C STATIONS ON THE INPUT FILES WILL BE PRINTED TO C THE FILE WHOSE UNIT NUMBER IS IP12. (INPUT) C ISTOP(J) = FOR J=1, ISTOP( ) IS INCREMENTED BY 1 EACH TIME C AN ERROR OCCURS THAT MAY BE FATAL. C FOR J=2, ISTOP( ) IS INCREMENTED BY 1 WHENEVER AN C INPUT DATA RECORD IS NOT FOUND. (INPUT-OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 39 = NWORDS FROM GFETCH DO NOT EQUAL NSTA. C SEE OTHER ROUTINES FOR OTHER VALUES. C C OUTPUT ARGUMENT LIST: C NWHERE(N) = INDICATES WHERE THE VARIABLE IS TO COME FROM (N=1,ND4) C 0 = UNDETERMINED C 1 = FROM INPUT FILE C 2 = BINARY FROM BASIC VARIABLE. IT IS POSSIBLE C THAT A VARIABLE REUSABLE IN VRBL66 WILL C NOT BE IN VRBL67, SO THIS MUST BE ALLOWED C FOR THERE. C 3 = FROM OPTX. THIS INCLUDES THE CASES WHERE A C POINT BINARY IS MADE FROM A COMPUTED VARIABLE. C (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. (CHARACTER*8) C (INPUT/OUTPUT) C AA(N,K) = MATRIX OF VALUES TO RETURN (N=1,NVRBL) (K=1,NSTA). C (OUTPUT) C ISTOP(J) = FOR J=1, ISTOP( ) IS INCREMENTED BY 1 EACH TIME C AN ERROR OCCURS THAT MAY BE FATAL. C FOR J=2, ISTOP( ) IS INCREMENTED BY 1 WHENEVER AN C INPUT DATA RECORD IS NOT FOUND. (INPUT-OUTPUT) C C DATA SET USE C INPUT FILES: C FORT.KFILRA(J) - UNIT NUMBERS FOR EXTERNAL RANDOM ACCESS FILES C (J=1,5). (INPUT/OUTPUT) C (INPUT) C C OUTPUT FILES: C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. SET BY C DATA STATEMENT IN DRU660. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILRA(J) = UNIT NUMBERS FOR READING MOS-2000 EXTERNAL C RANDOM ACCESS FILES (J=1,NUMRA). (INPUT) C NUMRA = NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (INPUT) C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NVRBL). C (INPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE C ID CORRESPONDING TO ID( ) (J=1,15) (N=1,NVRBL). C (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). HAS NO MEANING EXCEPT IN C U201. C JD(J,N) = THE BASIC INTEGER VARIABLE ID (J=1,4) (N=1,NVRBL). C THIS IS THE SAME AS ID(J,N), EXCEPT THAT SOME PORTIONS C ARE OMITTED: C B = IDPARS(3, ), C G = IDPARS(15, ), AND C TRESHL( ). C JD( , ) IS USED TO IDENTIFY WHICH CALCULATIONS C CAN BE MADE DIRECTLY IN U600, WHICH IS ONLY FORMING C BINARIES. THE "G" VARIABLE HAS NO MEANING IN U660, C IT BEING ONLY FOR POSSIBLE USE IN U201. C (INPUT) C NWHERE(N) = INDICATES WHERE THE VARIABLE IS TO COME FROM (N=1,ND4) C 0 = UNDETERMINED C 1 = FROM INPUT FILE C 2 = BINARY FROM BASIC VARIABLE. IT IS POSSIBLE C THAT A VARIABLE REUSABLE IN VRBL66 WILL C NOT BE IN VRBL67, SO THIS MUST BE ALLOWED C FOR THERE. C 3 = FROM OPTX. THIS INCLUDES THE CASES WHERE A C POINT BINARY IS MADE FROM A COMPUTED VARIABLE. C (OUTPUT) C NVRBL = THE NUMBER OF VARIABLES NEEDED AND IDENTIFIED IN C ID( , ), ETC. ALSO TREATED AS THE DIMENSION OF THE C VARIABLES ID( , ), ETC. (INPUT) C NDATE = THE DATE/TIME FOR WHICH VARIABLES ARE TO BE C FURNISHED ON THIS CALL TO VRBL66. (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/OUTPUT) C XDATA(K) = THE DATA FOR THE NSTA STATIONS BEING PROCESSED C (K=1,NSTA). (INTERNAL) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH. C DIMENSION OF SEVERAL ARRAYS. (INPUT) C AA(N,K) = MATRIX OF VALUES TO RETURN (N=1,NVRBL) (K=1,NSTA). C (OUTPUT) C NSTA = THE NUMBER OF STATIONS IN CCALL( , ). (INPUT) C ND5 = PASSED TO OPTX_ARCHIVE AND THEN TO READ_MOSDA. 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 IP12 = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C STATIONS ON THE INPUT FILES WILL BE PRINTED TO C THE FILE WHOSE UNIT NUMBER IS IP12. (INPUT) C ISTOP(J) = FOR J=1, ISTOP( ) IS INCREMENTED BY 1 EACH TIME C AN ERROR OCCURS THAT MAY BE FATAL. C FOR J=2, ISTOP( ) IS INCREMENTED BY 1 WHENEVER AN C INPUT DATA RECORD IS NOT FOUND. (INPUT-OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 39 = NWORDS FROM GFETCH DO NOT EQUAL NSTA. C SEE OTHER ROUTINES FOR OTHER VALUES. C (INTERNAL-OUTPUT) C ITIME = TO FURNISH TO GFETCH TO INDICATE NO TIME OFFSET C IS TO BE MADE BECAUSE OF RR AND AT THE SAME TIME C FOR PREDICTANDS, MINUS THE VALUE OF TAU. THIS C LATTER IS STORED IN LSTORE(12, ) BY GFETCH TO C ALLOW LMSTR6 TO CALCULATE THE MAXIMUM TAU BY C INPUT UNIT NUMBER. (INTERNAL) C NWORDS = NUMBER OF WORDS IN DATA( ) RETURNED FROM GFETCH. C (INTERNAL) C NTIMES = THE NUMBER OF TIMES, INCLUDING THIS ONE, THAT THE C DATA HAVE BEEN FETCHED. THIS IS STORED IN C LSTORE(9, ). (INTERNAL) C NSOURC = THE "MODEL NUMBER" OR SOURCE OF DATA TAKEN FROM C LSTORE(10, ) BY GFETCH. (INTERNAL) C MISSP = WHEN PRIMARY MISSING VALUE INDICATORS ARE IN THE C DATA RETURNED FROM GFETCH, THEY WILL HAVE THE C VALUE FLOAT(MISSP). OTHERWISE, MISSP = 0. C (INTERNAL) C MISSS = WHEN SECONDARY MISSING VALUE INDICATORS ARE IN THE C DATA RETURNED FROM GFETCH, THEY WILL HAVE THE C VALUE FLOAT(MISSS). OTHERWISE, MISSS = 0. C VRBL66 TREATS THIS MISSING VALUE AS ZERO. C (INTERNAL) C C SUBPROGRAMS CALLED: C UNIQUE: - OPTX_MERGE C LIBRARY: C MDLLIB90 - TIMPR, UPDAT C W3LIB - W3TAGE C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C 1345 - PARAMETER ND9 IS TOO SMALL (SHOULD NOT HAPPEN) C C REMARKS: C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 (xlf90 compiler) C MACHINE: IBM SP C C$$$ C CHARACTER*8 CCALL(ND1,6) C DIMENSION XDATA(ND1) DIMENSION DATA(ND5) DIMENSION ID(4,NVRBL),IDPARS(15,NVRBL), 1 JD(4,NVRBL), 2 NWHERE(NVRBL) DIMENSION AA(NVRBL,NSTA) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION ISTOP(2),KFILRA(5) DIMENSION INDEX(ND1,15) C IER=0 NFIRST=0 ICOUNT=0 C C INITIALIZE THE MATRIX AA( , ). C DO 105 K=1,NSTA C DO 104 N=1,NVRBL AA(N,K)=9999. 104 CONTINUE C 105 CONTINUE C DO 107 N=1,NVRBL NWHERE(N)=0 107 CONTINUE C C FIND ALL VARIABLES FOR THE DATE IN NDATE. C READ THROUGH THE NUMRA RANDOM ACCESS FILES IN ORDER. C SINCE UNIT 49 IS RESERVED FOR WRITING, UNIT 49 C IS NOT READ. C DO 500 J=1,NUMRA IF(KFILRA(J).NE.49)THEN NFIRST=NFIRST+1 ICOUNT=0 DO 400 N=1,NVRBL IER=0 C C THE DATA WILL BE RETURNED IN DATA( ). C CALL READ_MOSDA(KFILDO,KFILRA(J),IP12, 1 ID(1,N),NDATE,CCALL,NSTA, 2 DATA,ND1,ND5,ND7,IS0,IS1, 3 IS2,IS4,INDEX,IER) C C NOW FILL THE AA MATRIX C IF(IER.EQ.0.OR.IER.EQ.120)THEN NWHERE(N)=NWHERE(N)+1 ICOUNT=ICOUNT+1 IF(NFIRST.EQ.1)THEN DO 185 K=1,NSTA AA(N,K)=DATA(K) 185 CONTINUE ELSE DO 190 K=1,NSTA IF(NINT(AA(N,K)).EQ.9999.AND. 1 NINT(DATA(K)).NE.9999)THEN AA(N,K)=DATA(K) ENDIF 190 CONTINUE ENDIF IF(IER.EQ.120)THEN ISTOP(1)=ISTOP(1)+1 C IER = 120 FROM FINDST IN READ_MOSDA MEANS ONE OR MORE C STATIONS NOT FOUND IN THE DIRECTORY. THIS IS NOT FATAL. IER=0 ENDIF C ELSE ISTOP(2)=ISTOP(2)+1 C AN ERROR IN READ_MOSDA GENERATES A DIAGNOSTIC AND DATA IN C DATA( ) HAVE BEEN SET TO 9999. ISTOP(2) IS INCREMENTED, C EVEN WHEN IER = 47, WHICH JUST MEANS DATA COULD NOT C BE FOUND. (IT IS POSSIBLE THAT ERRORS OTHER THAN JUST C MISSING DATA OCCURRED.) ARRAY AA( , ) IS NOT TOUCHED C SINCE ARRAY WAS INITIALIZED WITH 9999. ENDIF C 400 CONTINUE WRITE(KFILDO,410)ICOUNT,KFILRA(J) 410 FORMAT(/,' FOUND AND READ ',I6,' RECORDS IN ', 1 'RANDOM ACCESS FILE UNIT NUMBER ',I2) C ENDIF C 500 CONTINUE DO 600 N=1,NVRBL IF(NWHERE(N).EQ.0)THEN WRITE(KFILDO,595)(ID(L,N),L=1,4),NDATE 595 FORMAT(/,' ****VRBL NOT READ IN ANY RANDOM ACCESS FILE', 1 /,' ID = ',I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 2 ' FOR DATE ',I11,'.') ENDIF 600 CONTINUE C RETURN END