SUBROUTINE DIRFUV(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA,
1 ID,IDPARS,JD,ITAU,
2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA,
3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
4 LSTORE,ND9,LITEMS,CORE,ND10,
5 NBLOCK,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,
7 L3264B,L3264W,IER)
C
C MARCH 1999 GLAHN TDL MOS-2000
C APRIL 1999 GLAHN ADDED TEST FOR BOTH U AND V = 0
C APRIL 1999 GLAHN ADDED ITAU TO CALL
C APRIL 1999 GLAHN CHANGED NDATE TO MDATE, ADDED ITIME
C APRIL 2000 RUDACK REPLACED GFETCH WITH RETVEC; ADDED TO
C CALL; ADDED NDIM AND YDATA( );
C COMMAS IN COMMENTS FOR IBM
C APRIL 2000 GLAHN ADDED DIMENSION FOR ISDATA( );
C IMPROVED COMMENTS; CHECKED SPELLING;
C ADDED NINT WHEN CHECKING FOR 9999;
C ELIMINATED ITIME AND ISTAV; INSURED
C /, IN **** COMMENTS
C APRIL 2000 RUDACK ADDED COMMENTS; ADDED DATA
C LDPARS/15*0/
C AUGUST 2002 MCALOON UPDATED ID'S TO ACCOMMODATE NGM WIND
C FCST BY MOD. PERFECT PROG.
C MARCH 2006 COSGROVE CHANGED TESTS FOR CALM WIND FROM
C EQUIVALENCING A REAL TO CHECKING
C IF THE |U| AND/OR |V| IS LESS THAN
C 0.1
C JUNE 2008 GLAHN ADDED 3 ITEMS TO ITABLE( , )
C SEPTEMBER 2008 GLAHN COMMENT IN PURPOSE
C JANUARY 2009 GLAHN ADDED /D IAGNOSTIC AT 150
C NOVEMBER 2009 GLAHN STATION AND GRIDDED WIND IDS
C NOVEMBER 2013 IM/GLAHN CHANGED IDS FOR LAMP
C ADDED NEW ENTRY FOR LAMP STATION
C OCTOBER 2014 GLAHN ADDED ENTRY FOR LAMP SPEED AND GUSTS
C
C PURPOSE
C TO COMPUTE WIND DIRECTION FROM U AND V COMPONENTS.
C THE VARIABLES ACCOMMODATED ARE INDICATED IN ITABLE(1,J).
C WHEN BOTH U AND V ARE 0, THE WIND DIRECTION IS SET TO
C MISSING (NO DIRECTION CAN BE DETERMINED.)
C POSSIBLE MISSING VALUES OF 9999. ARE TREATED AS
C MISSING = 9999. VECTOR DATA FROM THE MOS-2000 INTERNAL
C STORAGE SYSTEM WILL BE UNPACKED, WILL BE IN THE ORDER
C NEEDED. DIRFUV ASSUMES THERE WILL BE NO SECONDARY
C MISSING VALUES OF 9997; THESE SHOULD HAVE ALREADY BEEN
C TREATED. IT IS NOTED THAT IF DIRECTION IS COMPUTED
C FROM THE U AND V COMPONENTS WHICH THEMSELVES WERE
C COMPUTED FROM OBSERVED SPEED AND DIRECTION, THE
C DIRECTION WILL NOT BE RECOVERED EXACTLY.
C
C IDPARS(1) & IDPARS(2) OF U AND V COMPONENTS
C ARE MAPPED: INTO FROM
C 004200 004010, 004110 (U-V COMP. OF WINDS ON
C P-SURFACE)
C 004201 004011, 004111 (U-V COMP. OF WINDS ON
C CONST. HT. SFC.)
C 004202 004012, 004112 (GEOSTROPHIC U-V COMP. ON
C P-SURFACE)
C 704200 704010, 704110 (U-V WIND COMPONENT (KTS)
C - EARTH ORIENTED)
C 204225 204010, 204110 (LMP WIND U-V COMPONENTS)
C 204250 204020, 204120 (MOS WIND U-V COMPONENTS)
C 224200 224010, 224110 (SFC. WIND U-V COMPONENTS
C - NGM MOS FCST)
C 224250 224060, 224160 (MOS GRIDDED)
C 224235 224020, 224120 (LAMP GRIDDED)
C 724230 724020, 724120 (OBS GRIDDED)
C 704230 704020, 704120 (OBS STATION, HEIGHT ADJ)
C 204225 204010, 204110 (LAMP STATION)
C 204235 224020, 224120 (LAMP SPEED AND GUST)
C THESE LAST TWO ENTRRIES ARE FOR U155/U405A
C
C DATA SET USE
C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE.
C (OUTPUT)
C KFIL10 - UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS.
C (INPUT-OUTPUT)
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. (OUTPUT)
C KFILRA(J) - THE UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES
C ARE AVAILABLE (J=1,NUMRA). (INPUT)
C
C VARIABLES
C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE.
C (INPUT)
C KFIL10 = UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS.
C (INPUT)
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 KFILRA(J) = THE UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES
C ARE AVAILABLE (J=1,NUMRA). (INPUT)
C RACESS(J) = THE FILE NAMES ASSOCIATED WITH KFILRA(J) (J=1,NUMRA).
C (CHARACTER*60) (INPUT)
C NUMRA = THE NUMBER OF VALUES IN KFILRA( ) AND RACESS( ).
C (INPUT)
C ID(J) = THE PREDICTOR ID (J=1,4). (INPUT)
C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE
C PREDICTOR ID CORRESPONDING TO ID( ) (J=1,15).
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
C 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
C 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 PREDICTOR ID (J=1,4).
C THIS IS THE SAME AS ID(J), EXCEPT THAT THE
C PORTIONS 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 ITAU = THE NUMBER OF HOURS AHEAD TO FIND A VARIABLE.
C THIS HAS ALREADY BEEN CONSIDERED IN MDATE, BUT
C IS NEEDED FOR CALL TO RETVEC. (INPUT)
C NDATE = THE DATE/TIME FOR WHICH PREDICTOR IS NEEDED.
C (INPUT)
C MDATE = NDATE UPDATED WITH ITAU( ). (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)
C ISDATA(K) = WORK ARRAY (K=1,ND1). (INTERNAL)
C XDATA(K) = U-COMPONENT OF WIND, THEN THE WIND DIRECTION IS
C RETURNED IN XDATA(K) (K=1,NSTA). (OUTPUT)
C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT
C WITH. DIMENSION OF XDATA( ). (INPUT)
C NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT
C WITH. (INPUT)
C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN
C INTEGER VARIABLE (L=1,L3264W) (K=1,ND5).
C THIS ARRAY IS USED TO READ THE STATION DIRECTORY
C FROM A MOS-2000 EXTERNAL FILE. EQUIVALENCED
C TO CCALLD( ). (CHARACTER*8) (INTERNAL)
C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). EQUIVALENCED
C TO ICALLD( , ). (INTERNAL)
C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C DATA(K) = WORK ARRAY (J=1,ND5). (INTERNAL)
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
C CHARACTERISTICS OF THIS GRID.
C L=11 --THE NUMBER OF THE PREDICTOR IN THE SORTED
C LIST IN ID( ,N) (N=1,NPRED) FOR WHICH
C THIS VARIABLE IS NEEDED, WHEN IT IS
C NEEDED ONLY ONCE FROM LSTORE( , ).
C WHEN IT IS NEEDED MORE THAN ONCE, THE
C VALUE IS SET = 7777.
C L=12 --USED INITIALLY IN ESTABLISHING
C MSTORE( , ). LATER USED AS A WAY OF
C DETERMINING WHETHER TO KEEP THIS
C VARIABLE.
C ND9 = THE SECOND DIMENSION OF LSTORE( , ). (INPUT)
C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , )
C THAT HAVE BEEN USED IN THIS RUN. (INPUT)
C CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA
C IDENTIFIED IN LSTORE( , ) (J=1,ND10). WHEN
C CORE( ) IS FULL DATA ARE STORED ON DISK.
C (INPUT)
C ND10 = DIMENSION OF CORE( ). (INPUT)
C NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM
C DISK FILE. (INPUT)
C NFETCH = THE NUMBER OF TIMES RETVEC HAS BEEN ENTERED.
C RETVEC KEEPS TRACK OF THIS AND RETURNS THE
C VALUE. (OUTPUT)
C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3).
C (INTERNAL)
C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,22+).
C (INTERNAL)
C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12).
C (INTERNAL)
C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4).
C (INTERNAL)
C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ).
C NOT ALL LOCATIONS ARE USED. (INPUT)
C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING
C USED (EITHER 32 OR 64). (INPUT)
C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2).
C CALCULATED BY PARAMETER, BASED ON L3464B.
C (INPUT)
C IER = STATUS RETURN.
C 0 = GOOD RETURN.
C 102 = ID NOT ACCOMMODATED.
C SEE RETVEC FOR OTHER VALUES. (OUTPUT)
C LD(J) = HOLDS THE 4 ID WORDS OF THE DATA RETRIEVED INTO
C XDATA( ) FOR THE U COMPONENT (J=1,4).
C (INTERNAL)
C MD(J) = HOLDS THE 4 ID WORDS OF THE DATA RETRIEVED INTO
C YDATA( ) FOR THE V COMPONENT (J=1,4).
C (INTERNAL)
C LDPARS(J) = PARSED ID FILLED IN SUBROUTINE PRSID1 FOR
C U-COMPONENT (J=1,15). (INTERNAL)
C MDPARS(J) = PARSED ID FILLED IN SUBROUTINE PRSID1 FOR
C V-COMPONENT (J=1,15). (INTERNAL)
C ITABLE(I,J) = CCCFFF OF THE DIRECTION (I=1) AND THE NEEDED
C U COMPONENT (I=2) AND V COMPONENT (I=3)
C (J=1,NDIM). (INTERNAL)
C NDIM = SECOND DIMENSION OF ITABLE( , ). SET BY
C PARAMETER. (INTERNAL)
C YDATA(K) = V-COMPONENT OF WIND RETRIEVED IN RETVEC.
C (K=1,NSTA) (AUTOMATIC). (INTERNAL)
C 1 2 3 4 5 6 7 X
C
C NONSYSTEM SUBROUTINES CALLED
C PRSID1,RETVEC
C
PARAMETER (NDIM=13)
C
CHARACTER*8 CCALL(ND1,6)
CHARACTER*8 CCALLD(ND5)
CHARACTER*60 RACESS(5)
C
DIMENSION ISDATA(ND1),XDATA(ND1),YDATA(ND1)
C YDATA( ) IS AN AUTOMATIC ARRAY.
DIMENSION ID(4),IDPARS(15),JD(4)
DIMENSION LD(4),MD(4),KFILRA(5)
DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5)
DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7)
DIMENSION LSTORE(12,ND9),ICALLD(L3264W,ND5)
DIMENSION CORE(ND10)
DIMENSION ITABLE(3,NDIM),LDPARS(15),MDPARS(15)
C
DATA LDPARS/15*0/
DATA MDPARS/15*0/
DATA ITABLE/004200, 004010, 004110,
1 004201, 004011, 004111,
2 004202, 004012, 004112,
3 704200, 704010, 704110,
4 204225, 204010, 204110,
5 204250, 204020, 204120,
6 224200, 224010, 224110,
7 224250, 224060, 224160,
8 224235, 224020, 224120,
9 724230, 724020, 724120,
A 704230, 704020, 704120, !OBS DIRECTION 0 SPEED OR GUST U405A
B 204225, 204010, 204110, !
C 204235, 224020, 224120/ !LAMP DIRECTION 950000 SPEED OR GUST U405A
C 1 2 3 4 5 6 7 X
C
IER=0
CALL TIMPR(KFILDO,KFILDO,'START DIRFUV ')
C
C FIND THE LOCATION IN THE TABLE.
C
DO 105 JJ=1,NDIM
IF(ITABLE(1,JJ).EQ.IDPARS(1)*1000+IDPARS(2))GO TO 115
105 CONTINUE
C
WRITE(KFILDO,110)(JD(L),L=1,4),IDPARS(1),IDPARS(2)
110 FORMAT(/,' ****DIRFUV ENTERED FOR VRBL',
1 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3,
2 ' WITH CCCFFF = ',2I3,' IN IDPARS(1) AND IDPARS(2)',
3 ' NOT ACCOMMODATED.')
IER=102
GO TO 300
C
C GET THE U COMPONENT.
C
115 LD(1)=ITABLE(2,JJ)*1000+IDPARS(4)
LD(2)=JD(2)
LD(3)=JD(3)
LD(4)=IDPARS(13)*100+IDPARS(14)*10+IDPARS(15)
C
CALL PRSID1(KFILDO,LD,LDPARS)
CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA,
1 LD,LDPARS,JD,ITAU,
2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA,
3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
4 LSTORE,ND9,LITEMS,CORE,ND10,
5 NBLOCK,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,
7 L3264B,L3264W,IER)
C
C JD( ) IS NOT ACTUALLY USED IN RETVEC. IT IS USED
C IN CALL TO CONST, BUT CONST DOES NOT USE IT EITHER.
C
IF(IER.NE.0)THEN
WRITE(KFILDO,130)(LD(J),J=1,4)
130 FORMAT(/,' ****VARIABLE NOT RETRIEVED BY RETVEC IN DIRFUV',
1 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3)
GO TO 300
ENDIF
C
C GET THE V COMPONENT.
C
MD(1)=ITABLE(3,JJ)*1000+IDPARS(4)
MD(2)=JD(2)
MD(3)=JD(3)
MD(4)=LD(4)
C
CALL PRSID1(KFILDO,MD,MDPARS)
CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA,
1 MD,MDPARS,JD,ITAU,
2 NDATE,MDATE,CCALL,ISDATA,YDATA,ND1,NSTA,
3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
4 LSTORE,ND9,LITEMS,CORE,ND10,
5 NBLOCK,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,
7 L3264B,L3264W,IER)
C
C JD( ) IS NOT ACTUALLY USED IN RETVEC. IT IS USED
C IN CALL TO CONST, BUT CONST DOES NOT USE IT EITHER.
C
IF(IER.NE.0)THEN
WRITE(KFILDO,132)(MD(J),J=1,4)
132 FORMAT(/,' ****VARIABLE NOT RETRIEVED BY RETVEC IN DIRFUV',
1 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3)
GO TO 300
ENDIF
C
DO 211 J=1,NSTA
C
D WRITE(KFILDO,150)CCALL(J,1),XDATA(J),YDATA(J)
D150 FORMAT(/' AT 150 IN DIRFUV--CCALL(J,1),XDATA(J),YDATA(J)',
D 1 A6,2F10.2)
C
IF(NINT(XDATA(J)).NE.9999.AND.NINT(YDATA(J)).NE.9999)THEN
C
IF(ABS(YDATA(J)).LT.0.1)THEN
C
IF(ABS(XDATA(J)).LT.0.1)THEN
XDATA(J)=9999.
ELSE
XDATA(J)=SIGN(90.,XDATA(J))+180.
ENDIF
C
ELSE
XDATA(J)=57.29578*ATAN2(XDATA(J),YDATA(J))+180.
ENDIF
C
ELSE
XDATA(J)=9999.
ENDIF
C
211 CONTINUE
C
GO TO 350
C
C THIS VARIABLE CANNOT BE COMPUTED. SET XDATA( ) TO MISSING.
C THIS IS FOR SAFETY; XDATA( ) SHOULD ALREADY BE SET TO MISSING.
C
300 DO 310 J=1,NSTA
XDATA(J)=9999.
310 CONTINUE
C
350 RETURN
END