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