SUBROUTINE SCLVIS(KFILDO,KFIL10,NDATE,ID,IDPARS,JD,
1 IDOBS,CCALL,XDATA,FD2,FD3,ND1,NSTA,
2 NCAT,CONST,NSCALE,
3 IBSTRT,IBEND,CAP,MOSFUL,
4 LSTORE,ND9,LITEMS,
5 IS0,IS1,IS2,IS4,ND7,
6 IPACK,IWORK,DATA,ND5,
6 CORE,ND10,NBLOCK,NFETCH,
8 L3264B,ISTOP,IER)
C
C APRIL 2010 GLAHN TDL MOS-2000
C ADAPTED FROM SCLCIG
C FEBRUARY 2011 GLAHN COMPUTES FREQUENCIES ABOVE 7 MI
C FEBRUARY 2011 GLAHN REMOVED FREQUENCY COMPUTATION;
C ADDED CALL TO VISMBO; ADDED IBSTRT,
C IBEND
C MARCH 2011 GLAHN REMOVED FACTOR
C APRIL 2011 GLAHN ADDED IDOBS( )
C APRIL 2011 GLAHN ADDED ICUM; REVISED TO USE EITHER
C INCOMING CUMULATIVE PROBABILITIES
C OR DIFFERENCE AND USE DISCRETE
C MAY 2011 IM ADDED MOS PROBABILITIES (PROVIDED
C BY CVLMPM) TO ITABLE; REMOVED ICUM;
C ADDED IC
C JUNE 2014 GLAHN COMMENT, IER = 666 FROM VISMBO
C JANUARY 2015 GLAHN ADDED CCALL( ) TO CALL AND ADDED
C CCALL( ) TO CALL TO VISMBO
C FEBRUARY 2015 GLAHN ADDED MOSFUL TO CALL, AND USED IT
C AUGUST 2015 GLAHN ALTERED DIAGNOSTIC 147; ADDED
C DIAGNOSTIC 221
C AUGUST 2015 GLAHN ADDED SORTING CAPABILITY; ADDED
C TEST( ), PROB( ), FD2SAV( ) AND
C INDEX( ) FOR DIAGNOSTICS
C SEPTEMBER 2015 GLAHN CHANGED +.001 TO +.01 BELOW 152
C SEPTEMBER 2015 GLAHN ROUNDING TO 2 PALCES ABOVE 17 AND
C CHANGED CHECKING
C
C PURPOSE
C TO SCALE THE VALUES IN A CATEGORY OF VISIBILITY TO
C A CATEGORY AND FRACTION (E.G., 2 MAY BECOME 2.4)
C ACCORDING TO THE PROBABILITY RANGE FOR THIS CASE
C OVER THE DATA BEING ANALYZED, THEN TO TURN THAT SCALED
C VALUE INTO MILES (UNLESS CONST AND NSCAL DICTATE OTHERWISE).
C FINALLY, THEN MULTIPLY TIMES A CONST*10**NSCALE.
C THE NUMBER OF PROBABILITY CATEGORIES IS NCAT.
C NCAT MUST EQUAL IDCAT-1. HIGHER PROBABILITIES
C INDICATE LOWER VALUES IN THE CATEGORY, EXCEPT FOR THE UPPER
C CATEGORY WHERE THE REVERSE IS TRUE. THE INPUT IS A WHOLE
C NUMBER CATEGORY; THE OUTPUT IS VISIBILITY IN MILES.
C
C THIS WAS WRITTEN FOR LAMP VISIBILITY, AND ITABLE( , , )
C IS SPECIFIC TO THOSE CATEGORIES.
C
C IT IS ASSUMED THE LAMP PROBABILITIES READ ARE CUMULATIVE
C FROM BELOW, AND THE TABLE OF IDS REFLECTS THAT (B=2). THE
C PROBABILITIES ARE DIFFERENCED TO MAKE THEM DISCRETE AND
C ARE USED FOR SCALING.
C
C NSCALE FOR VIS IS NORMALLY 2, SO THOUSANDTHS CANNOT BE
C EXPECTED TO SURVIVE PACKING. THIS ROUTINE EXPECTS NSCALE
C TO BE GE 2.
C
C AFTER THIS SCALING, VISMBO (VISIBILITY MODIFIED BY
C OBS) IS CALLED TO PUT THE SCALED CATEGORIES INTO MILES
C FOR ANALYSIS. THE RUN TIME OBSERVATIONS CAN BE USED
C TO PERSIST THE ACTUAL VISIBILITY WHEN THE FORECAST IS FOR
C THE CATEGORY SPANNING THE OB (SEE IBSTRT AND IBEND BELOW).
C
C DATA SET USE
C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT)
C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE.
C (INPUT)
C
C VARIABLES
C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT)
C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE.
C (INPUT/OUTPUT)
C NDATE = DATE/TIME, YYYYMMDDHH, OF ANALYSIS RUN.
C (INPUT)
C ID(J) = ID OF VARIABLE TO PROVIDE DATA FOR ANALYSIS
C (J=1,4). (INPUT)
C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE
C VARIABLE ID'S CORRESPONDING TO ID( ,N)
C (J=1,15), (N=1,ND4).
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
C 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 (INPUT)
C JD(J) = THE BASIC INTEGER VARIABLE ID'S (J=1,4)
C (N=1,ND4).
C THIS IS THE SAME AS ID(J,N), 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 NOT ACTUALLY USED. (INPUT)
C IDOBS(J) = 4-WORD ID OF VISIBILITY OBSERVATIONS FOR
C PERSISTENCE AUGMENTATION (J=1,4).
C WORD 7 IN IDTABLE IN U405A. (INPUT)
C CCALL(K) = 8-CHARACTER STATION CALL LETTERS
C (K=1,NSTA). ALL STATION DATA ARE KEYED TO
C THIS LIST. (INPUT)
C XDATA(K) = CATEGORICAL VALUES ON INPUT; MILES
C ON OUTPUT (K=1,NSTA). (INPUT/OUTPUT)
C FD2(K) = WORK ARRAY (K=1,NSTA). HOLDS THE SCALED
C CATEGORY VALUES. (INTERNAL)
C FD3(K) = WORK ARRAY (K=1,NSTA). (INTERNAL)
C ND1 = FIRST DIMENSION OF XDATA( ) AND DIMENSION
C OF FD1( ). (INPUT)
C NSTA = NUMBER OF STATIONS BEING USED; THE NUMBER
C OF VALUES IN XDATA( ). (INPUT)
C NCAT = NUMBER OF VISIBILITY CATEGORIES. MUST
C BE IDCAT-1. (INPUT)
C CONST = THE MULTIPLIER FOR SCALING. (INPUT)
C NSCALE = THE POWER OF TEN FOR SCALING. (INPUT)
C IBSTRT = THE PROJECTION BELOW WHICH A FORECAST MAY BE
C SET TO THE OBSERVATION VALUE. (INPUT)
C IBEND = THE PROJECTION BELOW WHICH A FORECAST MAY BE
C A COMBINATION OF THE FORECAST AND OBSERVATION.
C (INPUT)
C CAP = CAP FOR VISIBILITY FOR USE IN VISMBO. (INPUT)
C MOSFUL = 1 WHEN MOS IS USED EXCLUSIVELY, VICE LAMP.
C THIS IS SET IN CVLMPM WHEN IDPARS(12) GE
C THE IBEND DEFINED AS INPUT TO CVLMPM. USED
C IN SCLVIS TO READ MOS PROBABILITIES VICE LAMP
C PROBABILITIES. (INPUT)
C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA
C STORED (L=1,12) (J=1,LITEMS). (INPUT/OUTPUT)
C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ).
C SECOND DIMENSION OF LSTORE( , ). (INPUT)
C LITEMS = THE NUMBER OF ITEMS J IN LSTORE( ,L).
C (INPUT/OUTPUT)
C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4).
C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+).
C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12).
C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4).
C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ).
C (INPUT)
C IPACK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL)
C IWORK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL)
C DATA(J) = WORK ARRAY FOR GFETCH (J=1,ND5) AND COMPUTATIONS.
C (INTERNAL)
C ND5 = DIMENSION OF IPACK( ), WORK( ), AND DATA( ).
C (INPUT)
C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT
C FIELDS (J=1,ND10). WHEN THIS SPACE IS
C EXHAUSTED, SCRATCH DISK WILL BE USED. THIS IS
C THE SPACE USED FOR THE MOS-2000 INTERNAL RANDOM
C ACCESS SYSTEM. (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 = INCREMENTED EACH TIME DATA ARE FETCHED BY
C GFETCH. IT IS A RUNNING COUNT FROM THE
C BEGINNING OF THE PROGRAM. THIS COUNT
C IS MAINTAINED IN CASE THE USER NEEDS IT
C (DIAGNOSTICS, ETC.). (OUTPUT)
C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING
C USED (EITHER 32 OR 64). (INPUT)
C ISTOP(J) = ISTOP(1) IS INCREMENTED BY 1 WHENEVER AN ERROR
C OCCURS AND THE PROGRAM PROCEEDS. ISTOP(3) IS
C INCREMENTED BY 1 WHEN A DATA RECORD COULD
C NOT BE FOUND. WHEN AN ERROR OCCURS AND IER IS
C RETURNED NE 0, THE INCREMENTING OF ISTOP(1)
C IS DONE IN THE CALLING PROGRAM (U405A).
C (INPUT/OUTPUT)
C IER = ERROR CODE.
C 0 = GOOD RETURN.
C 103 = COULD NOT IDENTIFY ID IN INTERNAL TABLE.
C 666 = OBS NOT AVAILABLE IN VISMBO.
C 777 = ANY OTHER ERROR.
C OTHER VALUES FROM CALLED ROUTNES. EVERY
C ERROR IS FATAL FOR THIS ELEMENT.
C (OUTPUT)
C NSLAB = SLAB OF THE GRID CHARACTERISTICS. RETURNED
C BY GFETCH. (INTERNAL)
C NTIMES = THE NUMBER OF TIMES GFETCH HAS BEEN ACCESSED.
C (INTERNAL)
C ITABLE(I,J,L) = HOLDS THE 4-WORD IDS OF THE NCAT-1 PROBABILITIES
C (I=1,4) (J=1,NCAT-1) AND OF THE ACTUAL VISIBILITY
C CATEGORY (J=IDCAT) FOR LAMP (L=1) AND FOR MOS (L=2).
C THE IDCAT ENTRY IS THE 4-WORD ID OF THE VARIABLE
C BEING PROCESSED SANS THE DD AND TAU (E.G.,
C THE CATEGORICAL VARIABLE). THESE ARE CUMULATIVE
C PROBABILITIES FROM BELOW FOR LAMP AND MOS, SO
C THE ENTRY ITABLE ( ,NCAT, ) IS MEANINGLESS.
C (INTERNAL)
C IC = 0 FOR LAMP CUMULATIVE PROBABILITIES;
C 1 FOR MOS CUMULATIVE PROBABILITIES, LABLED AS
C LAMP.
C TEST(K) = RETAINS THE ORIGINAL VALUES IN XDATA( ) FOR
C DIAGNOSTIC PRINT (K=1,NSTA_. (INTERNAL)
C PROB(K) = THE CATEGORICAL PROBABILITIES (K=1,NSTA).
C (INTERNAL)
C 1 2 3 4 5 6 7 X
C
C NONSYSTEM SUBROUTINES USED
C GFETCH
C
PARAMETER (IDCAT=8)
C
CHARACTER*8 CCALL(ND1)
C
DIMENSION ID(4),IDPARS(15),JD(4),IDOBS(4)
DIMENSION XDATA(ND1),FD2(ND1),FD3(ND1)
DIMENSION TEST(ND1),PROB(ND1),FD2SAV(ND1),INDEX(ND1)
C TEST( ), PROB( ), FD2SAV( ), AND INDEX( ) ARE AUTOMMATIC
C ARRAYS.
DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5)
DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7)
DIMENSION LSTORE(12,ND9)
DIMENSION CORE(ND10)
DIMENSION ISTOP(3),ITABLE(4,IDCAT,2),LD(4)
C
DATA ITABLE/208130200,0,0,495000000,
2 208130200,0,0,950000000,
3 208130200,0,0,195001000,
4 208130200,0,0,295001000,
5 208130200,0,0,505001000,
6 208130200,0,0,605001000,
7 208130200,0,0,999994000,
8 208131000,0,0,000000000,
C THE ABOVE ARE FOR NCAT-1 LAMP CUMULATIVE PROBABILITIES, PLUS
C THE CATEGORICAL ID. THE NCAT PROBABILITY IS MEANINGLESS.
C
A 208130200,1,0,495000000,
B 208130200,1,0,950000000,
C 208130200,1,0,195001000,
D 208130200,1,0,295001000,
E 208130200,1,0,505001000,
F 208130200,1,0,605001000,
G 208130200,1,0,999994000,
H 208131000,0,0,000000000/
C THE ABOVE ARE FOR NCAT-1 MOS CUMULATIVE PROBABILITIES. THE
C IDCAT VALUE IS NOT USED.
C
CALL TIMPR(KFILDO,KFILDO,'START SCLVIS ')
IER=0
C
C DETERMINE WHETHER VARIABLE IS IN THE ITABLE( ,IDCAT, ).
C THE DD IS NOT IN THE TABLE IN CASE THE MODEL CHANGES.
C THE TAU IS NOT IN THE TABLE TO MAKE IT GENERIC, BUT
C IS IN ID(3).
C
D WRITE(KFILDO,101)NCAT,
D 1 ((ITABLE(I,J,1),I=1,4),J=1,NCAT)
D101 FORMAT(/' AT 101 IN SCLVIS--NCAT,',
D 1 '((ITABLE(I,J,1),I=1,4),J=1,NCAT)',/,
D 2 I6,/,(4I11))
C
IF(ID(1).EQ.ITABLE(1,IDCAT,1)+IDPARS(4).AND.
1 ID(2).EQ.ITABLE(2,IDCAT,1).AND.
2 (ID(3)/1000).EQ.(ITABLE(3,IDCAT,1)/1000).AND.
3 ID(4).EQ.ITABLE(4,IDCAT,1))THEN
C THE CHECK IS MADE AGAINST THE LAMP ID.
GO TO 111
ENDIF
C
C DROP THROUGH HERE MEANS THE ID WAS NOT FOUND.
C
IER=103
WRITE(KFILDO,110)(ID(J),J=1,4),IER
110 FORMAT(/' ****VARIABLE ',I9.9,I10.9,I10.9,I4.3,' NOT',
1 ' ACCOMMODATED IN SUBROUTINE SCLVIS. IER =',I3)
GO TO 900
C
111 IF(NCAT.NE.IDCAT-1)THEN
IER=103
WRITE(KFILDO,112)NCAT,(ID(J),J=1,4),IER
112 FORMAT(/,' ****NCAT =',I3,' DOES NOT EQUAL IDCAT-1 IN SCLVIS.',
1 ' CANNOT PROCESS VARIABLE ',I9.9,I10.9,I10.9,I4.3,
2 '. IER =',I3)
GO TO 900
ENDIF
C
C FIND THE NCAT PROBABILITIES AND SCALE. THE CATEGORICAL
C VALUES ARE IN XDATA( ) ON INPUT AND WILL BE MODIFIED.
C
CCCCD WRITE(KFILDO,113)ND1,NSTA,(IDPARS(M1),M1=1,15)
CCCCD113 FORMAT(/' AT 113--,ND1,NSTA,(IDPARS(M1),M1=1,15)',
CCCCD 1 2I12/(15I8))
C
CCCCD WRITE(KFILDO,114)IBSTRT,IBEND,CAP,(K,XDATA(K),K=1,100)
CCCCD114 FORMAT(/' IN SCLVIS AT 114--IBSTRT,IBEND,CAP,',2I4,F6.2/
CCCCD 1 (8(I7,F8.2)))
C
C SET FD2( ) = 9999. AND TEST( ) TO XDATA( ).
C
DO 115 K=1,NSTA
FD2(K)=9999.
TEST(K)=XDATA(K)
115 CONTINUE
C
DO 200 J=1,NCAT
C PROBABILITIES ARE AVAILABLE FOR NCAT-1 CUMULATIVE CATEGORIES.
IC=0
C IC = 0 MEANS THE PROBABILITIES LOOKED FOR ARE CUMULATIVE
C FROM BELOW FOR LAMP.
C IC = 1 MEANS THE PROBABILITIES LOOKED FOR ARE CUMULATIVE
C FROM BELOW FOR MOS.
C
IF(J.LT.NCAT)THEN
C
C TRANSFER CUMULATIVE PROBABILITIES FROM DATA( ) TO FD3( ).
C
IF(J.GT.1)THEN
C
DO 118 K=1,NSTA
FD3(K)=DATA(K)
118 CONTINUE
C
ENDIF
C
C GET THE PROBABILITY OF CATEGORY J. THIS ACCOMMODATES
C EITHER LAMP CUMULATIVE PROBABILITIES OR MOS
C PROBABILITIES INTERPOLATED TO HOURLY VALUES BY
C CVLMPM.
C
DO 121 L=1,2
C
IF(L.EQ.1.AND.MOSFUL.EQ.1)THEN
C WHEN MOS IS USED EXCLUSIVELY, LAMP PROBABILITIES
C ARE NOT LOOKED FOR. LAMP PROBABILITIES ARE USED
C WHEN LAMP IS USED EXCLUSIVELY AND WHEN LAMP AND
C MOS CATEGORICAL FORECASTS ARE COMBINED.
IC=1
GO TO 121
ENDIF
C
C THE MOS PROBABILITIES ARE NOT LOOKED FOR WHEN MOSFUL
C = 1.
LD(1)=ITABLE(1,J,IC+1)+IDPARS(4)
C THE DD IS ADDED. THIS COULD BE EITHER LAMP OR MOS.
LD(2)=ITABLE(2,J,IC+1)
LD(3)=ITABLE(3,J,IC+1)+IDPARS(12)
C THE TAU IS ADDED.
LD(4)=ITABLE(4,J,IC+1)
CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS,
1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,ND5,
2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10,
3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER)
C
IF(IER.NE.0)THEN
ISTOP(3)=ISTOP(3)+1
WRITE(KFILDO,120)(LD(M1),M1=1,4)
120 FORMAT(/' ****COULD NOT FIND PROBABILITY RECORD',
1 3I10.9,I10,'. FATAL ERROR IN SCLVIS AT 120.')
C
IF(L.EQ.1)THEN
IC=MOD(IC+1,2)
C THIS SWITCHES IC BETWEEN 0 AND 1.
ELSE
GO TO 900
ENDIF
C
ELSE
GO TO 122
ENDIF
C
121 CONTINUE
C
122 CONTINUE
C
CCCCD WRITE(KFILDO,125)(K,DATA(K),K=1,100)
CCCCD125 FORMAT(/,' IN SCLVIS AT 125',/,(8(I7,F8.2)))
C
C CUMULATIVE PROBABILITIES HAVE BEEN READ INTO DATA( ).
C WHEN J = 1,THESE ARE ALSO DISCRETE AND ARE TRANSFERRED
C TO FD3( ) FOR COMPUTATION.
C
C DISCRETE PROBABILITIES ARE TO BE USED IN SCALING.
C TRUE LAMP PROBABILITIES ARE CUMULATIVE FROM BELOW,
C AND PSEUDO LAMP PROBABILITIES (ACTUALLY MOS
C INTERPOLATED AS NECESSARY TO HOURLY VALUES) ARE ALSO
C CUMULATIVE FROM BELOW.
C
IF(J.EQ.1)THEN
C
C DATA( ) HOLDS CUMULATIVE PROBABILITIES. WHEN
C THIS IS CATEGORY 1, THEY ARE ALSO DISCRETE.
C
DO 130 K=1,NSTA
FD3(K)=DATA(K)
130 CONTINUE
C
ELSE
C
DO 135 K=1,NSTA
FD3(K)=DATA(K)-FD3(K)
135 CONTINUE
C
ENDIF
C
ELSE
C
C THE NCAT CATEGORY CAN HAVE NO CUMULATIVE PROBABILITIES.
C CALCULATE THE DISCRETE PROBABILITIES FOR CATEGORY NCAT.
C
DO 145 K=1,NSTA
FD3(K)=1.-DATA(K)
145 CONTINUE
C
ENDIF
C
C SAVE THE PROBABILITIES FOR THE SPECIFIC CATEGORY FOR
C DIAGNOSTIC PRINT.
C
DO 1465 K=1,NSTA
C
IF(NINT(XDATA(K)).EQ.J)THEN
PROB(K)=FD3(K)
ENDIF
C
1465 CONTINUE
C
C FIND THE MAX AND MIN PROBABILITY FOR THIS CATEGORY.
C
CCCCD WRITE(KFILDO,146)(K,FD3(K),K=1,NSTA)
CCCCD 146 FORMAT(' AT 146'/(8(I6,F9.3)))
C
XMAX=-99999.
XMIN=99999.
D ICOUNT=0
C
DO 150 K=1,NSTA
C
CCCC IF(CCALL(K).EQ.'KARB ')THEN
CCCC WRITE(KFILDO,147)K,CCALL(K),XDATA(K),FD3(K)
CCCC 147 FORMAT(' IN SCLVIS AT 147--K,CCALL(K),XDATA(K),FD3(K) ',
CCCC 1 I6,2X,A8,2F10.3)
CCCC ENDIF
C
IF(NINT(FD3(K)).EQ.9999)GO TO 150
C
C CHECKING THE PROBABILITY. IT IS POSSIBLE THERE COULD
C BE MISSING PROBABILITIES EVEN THOUGH THE CATEGORICAL
C VALUE IS THERE. THE VALUES IN XDATA( ) ARE WHOLE
C NUMBERS, BUT THEY HAVE BEEN PACKED AND COULD BE
C SLIGHTLY BELOW THE CATEGORY NUMBER, SO USE NINT.
C
IF(NINT(XDATA(K)).EQ.J)THEN
D ICOUNT=ICOUNT+1
C
IF(FD3(K).LT.XMIN)THEN
XMIN=FD3(K)
ENDIF
C
IF(FD3(K).GT.XMAX)THEN
XMAX=FD3(K)
ENDIF
C
CCCCD WRITE(KFILDO,1495)XDATA(K),FD3(K),XMAX,XMIN,ICOUNT
CCCCD1495 FORMAT(' IN SCLVIS AT 1495--XDATA(K),FD3(K),XMAX,XMIN',
CCCCD 1 'ICOUNT',4F12.3,I7)
ENDIF
C
150 CONTINUE
C
IF(XMAX.EQ.-99999.)THEN
C THERE WERE NO FORECASTS IN THIS CATEGORY.
WRITE(KFILDO,152)J
152 FORMAT(/' THERE WERE NO FORECASTS IN CATEGORY',I4)
GO TO 200
ENDIF
C
IF(XMAX.EQ.XMIN)THEN
C
A=J+.5
B=0.
RANGE=0.
C FOR A CONSTANT VALUE, THE OUTPUT IS THE MIDPOINT
C OF THE CATEGORY NUMBER. THIS MIGHT HAPPEN
C IF THERE WERE ONLY ONE INSTANCE OF THE CATEGORY.
C NOTE THAT IF THERE ARE ONLY TWO INSTANCES AND
C THEY ARE DIFFERENT, THE OUTPUT WILL BE ONE VALUE
C AT THE LOW END OF THE CATEGORY AND ONE AT THE
C HIGH END--PROBABLY NOT A GOOD THING AND MAY
C HAVE TO BE MODIFIED, BUT OUGHT TO HAPPEN VERY
C INFREQUENTLY.
ELSE
RANGE=XMAX-XMIN
B=1./RANGE
A=J+1+B*XMIN
ENDIF
C
CCCC WRITE(KFILDO,160)J,XMAX,XMIN,RANGE,A,B
CCCC 160 FORMAT(/,' IN SCLVIS AT 160--J,XMAX,XMIN,RANGE,A,B',
CCCC 1 I4,5F10.3)
C
XMAXJ=J+.99
C XMAXJ IS USED TO KEEP THE CATEGORY FROM GOING INTO
C THE NEXT HIGHER CATEGORY. THIS IS CRITICAL FOR THE
C UPPER CATEGORY.
C
DO 170 K=1,NSTA
C
CCC WRITE(KFILDO,162)K,XDATA(K),FD3(K)
CCC 162 FORMAT(' ',I7,2F9.3)
C
IF(XDATA(K).GT.9998.9)GO TO 170
C IF THE CATEGORICAL VALUE IS MISSING, NO COMPUTATIONS
C POSSIBLE. FD2( ) HAS ALREADY BEEN INITIALIZED TO 9999.
C
IF(FD3(K).GT.9998.9)GO TO 170
C THIS GUARDS AGAINST A PROBABILITY BEING MISSING WHEN
C A CATEGORICAL VALUE IS THERE. THIS SHOULD NOT REALLY
C HAPPEN.
C
IF(NINT(XDATA(K)).EQ.J)THEN
C THE VALUES IN XDATA( ) ARE WHOLE NUMBERS, BUT THEY
C HAVE BEEN PACKED AND COULD BE SLIGHTLY BELOW THE
C CATEGORY NUMBER, SO USE NINT. XDATA( ) HAS NOT
C BEEN CHANGED IN SCLVIS UP TO THIS POINT.
C
IF(J.LT.NCAT)THEN
FD2(K)=MIN(A-B*FD3(K),XMAXJ)
C FOR LOWER CATEGORIES, A HIGH PROBABILITY MEANS
C A LOW VISIBILITY. FOR THE UPPER CATEGORY,
C NCAT, A HIGHER PROBABILITY MEANS A HIGH
C VISIBILITY. REVERSE THE ORIENTATION HERE.
ELSE
FD2(K)=MIN(J+B*(FD3(K)-XMIN),XMAXJ)
ENDIF
C
FD2(K)=FD2(K)*100.
FD2(K)=NINT(FD2(K))/100.
C THE ABOVE KEEPS 2 DECIMMAL PLACES, THE SAME AS PACKING.
IF(FD2(K).LT.J)FD2(K)=J+.01
IF(FD2(K).GE.J+1)FD2(K)=J+.99
C THE ABOVE ASSURES ALL SCALED VALUES ARE IN CAT J.
C A VALUE FD2( ) = 6.001 WOULD ROUND TO 6.00 IN PACKING.
C
CCCC WRITE(KFILDO,165)J,K,CCALL(K),A,B,FD3(K),XDATA(K),FD2(K)
CCCC 165 FORMAT(' AT 165--J,K,CCALL(K),A,B,FD3(K),XDATA(K),FD2(K)',
CCCC 1 2I6,2X,A8,5F10.3)
C
ENDIF
C
170 CONTINUE
C
200 CONTINUE
C
C THE COMPUTATIONS WERE IN FD2( ); PUT THEM IN XDATA( ).
C
DO 210 K=1,NSTA
XDATA(K)=FD2(K)
FD2SAV(K)=FD2(K)
210 CONTINUE
C
C THE VISIBILITY FORECASTS ARE NOW IN XDATA( ) IN CATEGORIES
C SCALED WITHIN THE CATEGORY BY THE PROBABILITY OF THE CATEGORY.
C NOW CALL VISMBO TO PUT THE SCALED CATEGORIES INTO
C VISIBILITY IN MILES AND MODIFY BY THE OBS WHEN THE
C FORECAST FALLS WITHIN THE CATEGORY, DEPENDING ON
C THE FORECAST PROJECTION IDPARS(12).
C
C SORT AND WRITE THE VALUES FOR DIAGNOSTIC PURPOSES.
C
D CALL SORTBG(KFILDO,FD2,IWORK,NSTA)
D WRITE(KFILDO,215)(K,TEST(IWORK(K)),PROB(IWORK(K)),
D 1 FD2(K),CCALL(IWORK(K)),K=1,NSTA)
D215 FORMAT(/' SORTED SCALED CATEGORICAL FORECASTS.',/,
D 1 ' NUMBER CATEGORY PROBABILITIES SCALED VALUE',
D 2 ' STATION'//,
D 2 (I7,F11.0,F10.3,F15.3,9X,A8))
C THIS IS FORMATTED FOR 8 CATEGORIES.
C
C SAVE IWORK( ) IN INDEX( ) FOR WRITING.
C
DO 216 K=1,NSTA
INDEX(K)=IWORK(K)
216 CONTINUE
C
CALL VISMBO(KFILDO,KFIL10,NDATE,ID,IDPARS,JD,
1 IDOBS,CCALL,XDATA,FD2,FD3,ND1,NSTA,
2 CONST,NSCALE,
3 IBSTRT,IBEND,CAP,
4 LSTORE,ND9,LITEMS,
5 IS0,IS1,IS2,IS4,ND7,
6 IPACK,IWORK,DATA,ND5,
7 CORE,ND10,NBLOCK,NFETCH,
8 L3264B,ISTOP,IER)
C IER = 666 WHEN OBS COULD NOT BE RETRIEVED. DEALT
C WITH IN U405A.
D WRITE(KFILDO,218)(K,TEST(INDEX(K)),PROB(INDEX(K)),
D 1 FD2SAV(INDEX(K)),XDATA(INDEX(K)),
D 2 CCALL(INDEX(K)),K=1,NSTA)
D218 FORMAT(/' SORTED SCALED CATEGORICAL FORECASTS.',/,
D 1 ' NUMBER CATEGORY PROBABILITIES SCALED VALUE',
D 2 ' SCALED CIG (MI) STATION'/,52X,'PLUS OBS',//,
D 2 (I7,F11.0,F10.3,F15.3,F15.3,10X,A8))
C
DO 220 K=1,NSTA
C
CCCC IF(CCALL(K).EQ.'KARB ')THEN
CCCC WRITE(KFILDO,221)CCALL(K),XDATA(K)
CCCC 221 FORMAT(' IN SCLVIS AT 221--CCALL(K),XDATA(K) ',
CCCC 1 A8,F10.3)
CCCC ENDIF
C
220 CONTINUE
C
CCCCD WRITE(KFILDO,225)IER,(K,XDATA(K),K=1,NSTA)
CCCCD225 FORMAT(/,' IN SCLVIS AT 225, IER =',I5/,(8(I7,F8.2)))
C
CALL TIMPR(KFILDO,KFILDO,'END SCLVIS ')
C
900 RETURN
END