SUBROUTINE SETVTG(KFILDO,KFIL10,ID,IDPARS,JD,NDATE,NAREA,
1 CCALL,NAME,DIR,FD2,FD4,ND1,NSTA,
2 P,NX,NY,IPACK,IWORK,
3 LSTORE,ND9,LITEMS,CORE,ND10,
4 NBLOCK,NFETCH,
5 IS0,IS1,IS2,IS4,ND7,
6 L3264B,ISTOP,JER,IER)
C
C NOVEMBER 2019 GLAHN MDL MOS-2000
C TAKEN FROM PIXSM1
C NOVEMBER 2019 GLAHN INTERPOLATION REMOVED
c
C PURPOSE
C TO READ THE VECTOR MELD FORECASTS THAT HAVE BEEN
C PUT INTO THE LAMP CATEGORIES AND TO MAKE SURE THE
C THE FOUR GRIDPOINTS AROUND EACH STATION MATCH THE MELD
C CATEGORICAL FORECASTS. IF THEY MATCH, NO CHANGE IS
C MADE; IF THEY DON'T MATCH, THE FOUR POINTS ARE CHANGED
C A MINIMAL AMOUNT TO BE WITHIN THE LAMP/MELD CATEGORY.
C
C THE FORECAST GRID HAS NOT BEEN PACKED YET, BUT WILL BE
C ON OUTPUT.
C
C DATA SET USE
C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT)
C KFIL10 = UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS.
C (INPUT)
C
C VARIABLES
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 ID(J) = THE VARIABLE 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 JD(J,N) = THE BASIC INTEGER VARIABLE ID (J=1,4) (N=1,NPRED).
C THIS IS THE SAME AS ID(J,N), 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 (INPUT)
C NDATE = THE DATE/TIME FOR WHICH DATA ARE NEEDED. (INPUT)
C NAREA = THE AREA BEING USED:
C 1 = CONUS
C 2 = ALASKA
C 3 = HAWAII
C 4 = PUERTO RICO
C ISPOT = THE SIZE OF SPOT TO REMOVE. (INPUT)
C MTIMES = NUMBER OF PASSES OVER THE DATA.
C MTIMES SHOULD BE EVENLY DIVISIBLE BY 4 FOR SYMMETRY.
C (INTERNAL)
C DIFFV = DIFFERENCE BETWEEN END POINTS WHEN EXCEEDED
C REMOVAL IS NOT DONE. (INPUT)
C DIFFA = THE ELEVATION DIFFERENCE IF EXCEEDED, REMOVAL
C IS NOT DONE. (INPUT)
C CCALL(K) = 8-CHARACTER STATION CALL LETTERS TO PROVIDE
C OUTPUT FOR (K=1,NSTA). ALL STATION
C DATA ARE KEYED TO THIS LIST. (CHARACTER*8)
C (INPUT)
C NAME(K) = NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20)
C (INPUT)
C DIR(K,J) = THE IX (J=1) AND JY (J=2) POSITIONS ON THE GRID
C FOR STATION K (K=1,NSTA), (INPUT/OUTPUT)
C FD2(J) = WORK ARRAY (J=1,ND1). HOLDS INTERPOLATED VALUES
C BEFORE PIXEL SMOOTHING. (INTERNAL)
C FD4(J) = WORK ARRAY (J=1,ND1). HOLDS THE VECTOR (STATION)
C FORECASTS FROM THE STATION PROCESS. (INTERNAL)
C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH.
C DIMENSION OF SEVERAL VARIABLES. (INPUT)
C NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT WITH.
C (INPUT)
C P(IX,JY) = HOLDS THE DATA TO PROCESS (IX=1,NX) (JY=1,NY).
C NX,NY = DIMENSIONS OF P( , ) AND HOLD( , ). (INPUT)
C (INPUT/OUTPUT)
C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C DATA(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C HOLD(IX,JY) = WORK ARRAY (IX=1,NX) (JY=1,NY). (INTERNAL)
C TELEV(IX,JY) = TERRAIN ELEVATION (IX=1,NX) (JY=1,NY). (INPUT)
C SEALND(J) = THE LAND/SEA MASK (J=1,NX*NY) AT NOMINAL
C MESHLENGTH MESH.
C 0 = OCEAN WATER GRIDPOINTS;
C 3 = INLAND WATER GRIDPOINTS.
C 9 = LAND GRIDPOINTS.
C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA
C STORED (L=1,12) (J=1,LITEMS).
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 TDLPACK, 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 L=11 --THE NUMBER OF THE FIRST VARIABLE IN THE
C LIST IN ID( ,N) (N=1,NPRED) FOR
C WHICH THIS VARIABLE IS NEEDED, WHEN IT
C DOES NOT NEED TO BE STORED AFTER DAY 1.
C WHEN THE VARIABLE MUST BE STORED (TO BE
C ACCESSED THROUGH OPTION) FOR ALL DAYS,
C ID(11,N) IS 7777 + THE NUMBER OF THE
C FIRST VARIABLE IN THE LIST FOR WHICH
C THIS VARIABLE IS NEEDED.
C CHARACTERISTICS OF THIS GRID.
C L=12 --USED INITIALLY IN ESTABLISHING
C MSTORE( , ). LATER USED AS A WAY OF
C DETERMINING WHETHER TO KEEP THIS VARIABLE.
C (INPUT)
C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ).
C SECOND DIMENSION OF LSTORE( , ). (INPUT)
C LITEMS = THE NUMBER OF ITEMS IN LSTORE( , ). (INPUT)
C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT
C FIELDS OR UNPACK STATION DATA (J=1,ND10).
C WHEN THIS SPACE IS EXHAUSTED, SCRATCH DISK
C WILL BE USED. THIS IS THE SPACE USED FOR
C THE MOS-2000 INTERNAL RANDOM ACCESS SYSTEM.
C (INPUT)
C ND10 = THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF
C DATA CORE( ). WHEN THIS SPACE IS EXHAUSTED,
C SCRATCH DISK WILL BE USED. (INPUT)
C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK
C STORAGE. (INPUT)
C NFETCH = NUMBER OF TIMES A RECORD HAS BEEN FETCHED FROM
C INTERNAL STORAGE. (INPUT/OUTPUT)
C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4).
C (INTERNAL)
C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+).
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
C IS4( ). (INPUT)
C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING USED
C (EITHER 32 OR 64). (INPUT)
C ISTOP(J) = (J=1,2):
C ISTOP(1)--IS INCREMENTED BY 1 EACH TIME AN ERROR
C OCCURS.
C ISTOP(2)--IS INCREMENTED WHEN A DATA RECORD
C COULD NOT BE FOUND.
C (INPUT/OUTPUT)
C JER = 0 UNTIL A MAJOR ERROR OCCURS, THEN IT IS
C INCREMENTED BY 1. IT COUNTS THE MAJOR ERRORS
C THAT WILL CAUSE EITHER NO GRID, A COMPROMISED
C GRID, OR A 9999 (MISSING) GRID TO BE OUTPUT.
C THIS INCLUDES A GRID THAT COULD NOT BE
C CHECKED WITH STATION FORECASTS. (INPUT/OUTPUT)
C IER = STATUS RETURN.
C 0 = GOOD RETURN.
C 103 = VARIABLE IN ID( ) IS NOT CEILING OR
C VISIBILITY.
C (INTERNAL-OUTPUT)
C 1 2 3 4 5 6 7 X
C
C NONSYSTEM SUBROUTINES USED
C PLASTC1, PLASTV1, GFETCH
C
PARAMETER (IDIM=2)
C
CHARACTER*8 CCALL(ND1)
CHARACTER*20 NAME(ND1)
C
DIMENSION ID(4),IDPARS(15),JD(4)
DIMENSION FD2(ND1),FD4(ND1),IPACK(NX*NY),IWORK(NX*NY)
DIMENSION DIR(ND1,2)
DIMENSION P(NX,NY)
DIMENSION SAVE(NX,NY)
C SAVE( , ) IS AN AUTOMATIC ARRAY.
DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7)
DIMENSION LSTORE(12,ND9)
DIMENSION CORE(ND10)
DIMENSION LD(4),ITABLE(3,IDIM),ISTOP(2)
C
DATA ITABLE/228080095,1,208071035, !CEILING FCST (CATEGORICAL)
3 228160095,2,208131035/ !VISIBILITY FCST (CATEGORICAL)
C DD 35 IS FOR LAMP; 95 IS FOR MELD
C THESE ARE IDS FOR CEILING AND VISIBILITY. DD=95 IS MELD; DD=35 IS FINAL
C (BULLETIN) A 1 INDICATES CEILING AND A 2 INDICATES VISIBILITY.
C
CALL TIMPR(KFILDO,KFILDO,'START SETVTG ')
C
IER=0
C
C MAKE SURE THIS SUBROUTINE DEALS WITH HRRR OR RAP MELD CEILING
C HEIGHT OR VISIBILITY.
C
DO 1005 M=1,IDIM
C
IF(ID(1).EQ.ITABLE(1,M))THEN
L=ITABLE(2,M)
C M IS THE ENTRY INTO ITABLE( ,M).
WRITE(KFILDO,1003)ID(1)
1003 FORMAT(/' IN SETVTG, CATEGORICAL VARIABLE BEING PROCESSED =',
1 I11)
GO TO 120
ENDIF
C
1005 CONTINUE
C
IER=103
WRITE(KFILDO,101)(ID(J),J=1,4),IER
101 FORMAT(/' ****ID(1) DOES NOT INDICATE CIG OR VIS IN SETVTG',
1 /' VARIABLE ',I9.9,I10.9,I10.9,I4.3,' NOT',
2 ' ACCOMMODATED IN SETVTG. IER =',I4)
GO TO 800
C
C FETCH THE STATION FORECASTS THAT WERE MADE FOR THE
C BULLETIN IN FD4( ).
C
120 LD(1)=ITABLE(3,M)
LD(2)=0
LD(3)=IDPARS(12)
LD(4)=0
ITIME=0
CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS,
1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD4,ND1,
2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10,
3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,
4 ITIME,IER)
C
IF(IER.NE.0)THEN
WRITE(KFILDO,220)
220 FORMAT(/' ****COULD NOT READ STATION MELD FORECASTS, SO',
1 ' CANNOT CHECK GRID WITH STATION FORECASTS.')
ISTOP(2)=ISTOP(2)+1
JER=JER+1
IREAD=0
ELSE
IREAD=1
C IREAD INDICATES A GOOD READ AND PLASTC1 OR PLASTV1
C WILL BE ENTERED.
ENDIF
C
WRITE(KFILDO,222)(K,CCALL(K),NAME(K),FD4(K),K=1,NSTA)
222 FORMAT(' IN SETVTG AT 222--(K,CCALL(K),NAME(K),FD4(K),K=1,NSTA)',
1 I6,2X,A8,2X,A20,F8.1)
C
C CHECK TO SEE WHETHER STATION FORECASTS FROM THE GRID ARE
C CONSISTENT WITH THE FEWER LAMP CATEGORIES. IF NOT, THE
C GRIDPOINTS AROUND THE STATION ARE MADE CONSISTENT.
C
IF(IREAD.EQ.1)THEN
C
IF(L.EQ.1)THEN
CALL PLASTC1(KFILDO,CCALL,NAME,FD4,DIR,ND1,NSTA,
1 P,NX,NY,IER)
C THIS PASSES THE SLAB FOR THE GRID IN DIR( , , ). THERE IS
C NO NON-ZERO ERROR RETURN.
ELSEIF(L.EQ.2)THEN
CALL PLASTV1(KFILDO,CCALL,NAME,FD4,DIR,ND1,NSTA,
1 P,NX,NY,IER)
C THIS PASSES THE SLAB FOR THE GRID IN DIR( , , ). THERE IS
C NO NON-ZERO ERROR RETURN.
ENDIF
C
ENDIF
C
GO TO 900
C
C SET OUTPUT FIELD TO MISSING WHEN AN ERROR HAS OCCURRED.
C
800 DO 802 JY=1,NY
DO 801 IX=1,NX
P(IX,JY)=9999.
801 CONTINUE
802 CONTINUE
C
ISTOP(1)=ISTOP(1)+1
JER=JER+1
C
900 CONTINUE
CALL TIMPR(KFILDO,KFILDO,'END SETVTG ')
RETURN
END