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