SUBROUTINE VISMBO(KFILDO,KFIL10,NDATE,ID,IDPARS,JD, 1 IDOBS,CCALL,XDATA,FD2,FD3,ND1,NSTA, 2 CONST,NSCAL, 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 C FEBRUARY 2011 GLAHN MDL MOS-2000 C APRIL 2011 GLAHN ADDED IDOBS( ) C APRIL 2011 GLAHN OMITTED DO 216 TEST LOOP C MAY 2011 GLAHN INITIALIZED IFREQ( ) C JUNE 2013 IM MODIFIED FORMAT STATEMENT C 237 FOR INTEL COMPILER C JUNE 2014 GLAHN KER DEFINED AND USED C JANUARY 2015 GLAHN MODIFIED ALGORITHM IN DO 180 LOOP C AS A SAFETY BUT IT WAS WORKING OK; C COMMENTS; OTHER SLIGHT MODS C MARCH 2015 GLAHN INSERTED GO TO 220 IN DO 220 LOOP C APRIL 2015 GLAHN MODIFIED WRITING LD( ) TO IOBS( ) C AT 170 C AUGUST 2015 GLAHN ADDED ITEST( ) AND WRITING SORTED C DATA FOR DIAGNOSTICS C SEPTEMBER 2015 GLAHN CHANGED .499 TO .49 AND .501 TO C .51 NEAR 137; CHANGED 1.001 TO 1.01 C BELOW 130; COMMENTS; OTHER SIMILAR C CHANGES TO GUARD AGAINST ROUNDING C IN PACKIG C SEPTEMBER 2015 GLAHN ADDED DIAGNOSTICS 1785,86,87 AND 89 C NOVEMBER 2018 HUANG CHANGED MAXIMUM VISIBILITY FROM C 10.01 to 10.08 FOR IMAGE PRODUCTION C PURPOSES. C C PURPOSE C TO POSTPROCESS A SCALED VISIBILITY CATEGORY AT STATIONS C INTO A CONTINUOUS VARIABLE IN MILES, THEN POSSIBLY C MODIFIED BY OBSERVATIONS. C C CATEGORY 6 DEFINES VISIBILITY TO BE BETWEEN > 5 AND C < OR = 6 MILES. CATEGORY 7 DURING DEVELOPMENT INCLUDES C ALL VALUES GREATER THAN 6. IT IS BELIEVED THE PROBABILITY C OF CATEGORY 6 CONTAINS SUFFICIENT INFORMATION TO SCALE C THAT CATEGORY UP TO 15 or 20 MILES. HOWEVER, THE C OBSERVATIONS OF VISIBILITY ARE RARELY > 10, SO TO BE C CONSISTENT, THE SCALED VALUES ARE THEN TRUNCATED AT C VISMAX MILES WHICH IS CURRENTLY SET AT 10. THE C DISTRIBUTION BETWEEN 6 AND 10 (VISMAX) MILES IS C CONTROLLED BY THE INPUT VARIABLE CAP. THE 10 IS GOVERNED C BY VISMAX WHICH COULD BE CHANGED TO ALLOW GREATER VALUES. C C AFTER THE CONVERSION OF LAMP CATEGORIES TO VISIBILITY IN C MILES, THE VISIBILITY OBS ARE USED TO POSSIBLY MODIFY C THE FORECAST VALUES. WHEN THE PROJECTION IS LE IBSTRT, C THE FORECAST IS REPLACED BY THE OBSERVATION WHEN, AND C ONLY WHEN, THE FORECAST CATEGORY ENCOMPASSES THE OB. C WHEN THE PROJECTION IS GT IBSTRT AND LT IBEND, THE C FORECAST IS REPLACED BY A WEIGHTED AVERAGE OF THE C FORECAST AND THE OB, WEIGHTED BY THE DISTANCE THE C PROJECTION IS FROM IBSTRT. WHEN THE PROJECTION IS C GE IBEND, THE FORECAST IS NOT MODIFIED BY THE OB. C THIS KEEPS THE FORECAST GRID AS CONSISTENT AS POSSIBLE C WITH THE OBSERVATION ANALYSIS AND STILL BE CONSISTENT C WITH THE FORECAST CATEGORIES AT SHORT PROJECTIONS, AND C GRADUALLY CUT LOOSE FROM THE OBS. C C THE SCALED VALUES FOR CATEGORY J WILL BE J.000 TO J.990 C COMING INTO VISMBO FROM SCLVIS. NSCALE FOR VIS IS C NORMALLY 2, SO THOUSANDTHS CANNOT BE EXPECTED TO C SURVIVE PACKING. THIS ROUTINE EXPECTS NSCALE TO BE GE 2. C C THE VARIABLE IS THEN SCALED BY FACTOR=CONST*10.**NSCAL. C NORMALLY CONST = 1 AND NSCAL = 0, AND NO CHANGE OCCURS. C NSCAL IS NOT NSCALE FOR TDLPACING. C C VISMBO IS CALLED FROM SCLVIS; VISMBO = VISIBILITY C MODIFIED BY OBSERVATIONS. 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 THE 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). (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) = SCALED CATEGORICAL VALUES ON INPUT; ACTUAL C VALUES IN MILES ON OUTPUT (K=1,NSTA). C (INPUT/OUTPUT) C FD2(K) = WORK ARRAY (K=1,ND1). HOLDS FORECASTS AS C THEY ARE BEING MODIFIED. (INTERNAL) C FD3(K) = WORK ARRAY (K=1,ND1). HOLDS OBS. (INTERNAL) C ND1 = SIZE OF SEVERAL VARIABLES. (INPUT) C NSTA = NUMBER OF VALUES BEIN PROCESSED. THE NUMBER C OF VALUES IN XDATA( ). (INPUT) C CONST = THE MULTIPLIER FOR SCALING. (INPUT) C NSCAL = 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 = THE VALUE TO SET TABLE(2,NOCAT) TO GOVERN C HOW MANY VALUES OF 10 ARE USED. USE A HIGH C VALUE TO GET MOSTLY 10'S WITHIN THE HIGHER C CATEGORY. (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). 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 (OUTPUT) C TABLE(J,M) = HOLDS THE LOWER AND UPPER CATEGORY BREAKPOINTS C FOR THE NOCAT CATEGORIES OF VISIBILITY C (M=1,NOCAT), (J=1,2). (INTERNAL) SET BY DATA C STATEMENT. C C THE VISIBILITY CATEGORIES ARE: C C CAT VALUES C 1 0 < 1/2 C 2 < 1 C 3 < 2 C 4 < 3 C 5 = 3 - 5 C 6 = 6 C 7 > 6 C NOCAT = THE NUMBER OF DISCRETE VISIBILITY CATEGORIES C FORECAST BY LAMP = 7. (INTERNAL) C VISMAX = THE MAXIMUM VISIBILITY IN MILES TO PUT ON THE C GRID, UNLESS REPLACED BY OB. SET BY DATA C STATEMENT TO 10. (INTERNAL) C KER = 1 WHEN OBS DATA COULD NOT BE RETRIEVED, AND IER C SET = 666. ZERO OTHERWISE. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C PARAMETER(NOCAT=7) C CHARACTER*8 CCALL(ND1) C DIMENSION ID(4),IDPARS(15),JD(4),IDOBS(4) DIMENSION XDATA(ND1),FD3(ND1),FD2(ND1) DIMENSION TEST(ND1) C TEST( ) IS AN AUTOMATIC ARRAY. DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION TABLE(2,NOCAT) DIMENSION FREQ(15),IFREQ(15),RFREQ(15),ISTOP(6),LD(4) DATA FREQ/ .5,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11,12.,15.,999./ DATA IFREQ/15*0/ C DATA TABLE/.0 , .4999, 2 .4999, .999, 3 .999, 1.999, 4 1.999, 2.999, 5 2.999, 5.001, 6 5.001, 6.001, 7 6.001, 60.0/ C 7 6.001, 30.0/ C THESE TABLED VALUES ARE OFFSET FROM INTEGERS IN A WAY THAT C MATCHES THE CATEGORY DEFINITIONS. WITH THE INCOMING SCALED C CATEGORIES BEING TRUNCATED ON THE HIGH END AT .99, THESE C VALUES SHOULD CAPTURE THE FRACTIONAL VALUES CORRECTLY. C THE HIGH VALUE FOR TABLE(2,NOCAT) WILL SCALE THE UPPER C CATEGORY BETWEEN 6 AND CAP BEFORE BEING TRUNCATED TO C VISMAX=10. THE 60 IN THE TABLE IS A PLACE HOLDER AND C IS REPLACED BY CAP. C CALL TIMPR(KFILDO,KFILDO,'START VISMBO ') IER=0 KER=0 C D WRITE(KFILDO,102)CONST,NSCAL,CAP,IBSTRT,IBEND,IDPARS(12) D102 FORMAT(/' AT 102 IN VISMBO--CONST,NSCAL,CAP,', D 1 'IBSTRT,IBEND,IDPARS(12)',F10.4,I4,F6.1,3I4) C CCCCD WRITE(KFILDO,105)(XDATA(K),K=1,NSTA) CCCCD105 FORMAT(/,' IN VISMBO AT 105--XDATA(K)',/,(15F8.2)) C IF(IBEND.LT.IBSTRT)THEN WRITE(KFILDO,110)IBSTRT,IBEND 110 FORMAT(/' ****IBSTRT =',I4,' SHOULD BE LE IBEND =',I4, 1 '. IBEND SET = IBSTRT. PROCEEDING.') IBEND=IBSTRT ISTOP(1)=ISTOP(1)+1 ENDIF C IF(IBSTRT.NE.0.AND.IBSTRT.EQ.IBEND)THEN WRITE(KFILDO,112)IBEND 112 FORMAT(/' ****NBSTRT = IBEND WILL GIVE NO OBS OVERRIDE', 1 ' AT IBEND. MAY WANT TO INCREASE IBEND TO', 2 ' > ',I4,'. PROCEEDING.') ISTOP(1)=ISTOP(1)+1 ENDIF C C SET VISMAX = 10 PLUS A SLIGHT INCREMENT AND C TABLE(2,NOCAT)=CAP. C VISMAX=10.08 TABLE(2,NOCAT)=CAP C C TURN CATEGORICAL VALUES SCALED WITHIN CATEGORIES INTO C ACTUAL VISIBILITIES IN MI. IT IS EXPECTED THAT THE C INCOMING "CONST" WILL BE 1.0 AND THAT "NSCAL" WILL BE C ZERO SO THAT THE OUTPUT WILL BE IN MILES. C 125 DO 160 K=1,NSTA TEST(K)=XDATA(K) C TEST( ) PRESERVES THE CATEGORY FORECASTS BEFORE SCALING. C IF(XDATA(K).GT.9998.5)THEN FD2(K)=XDATA(K) GO TO 160 C MISSINGS ARE RETAINED. ENDIF C J=XDATA(K) C THIS TRUNCATES TO THE CATEGORY NUMBER J. A VALUE OF C 2.0 TO 2.99 SHOULD GO INTO CATEGORY 2. C IF(J.GT.NOCAT)THEN WRITE(KFILDO,130)XDATA(K),NOCAT 130 FORMAT(/' ****INCOMING CATEGORICAL DATUM =',F8.4, 1 ' IS OUTSIDE RANGE 1 TO ',I4,' IN VISMBO.', 2 ' THIS IS AN ERROR.') XDATA(K)=NOCAT+.99 TEST(K)=XDATA(K) C MAKE THE CATEGORY THE TOP OF NOCAT. FD2(K)=VISMAX C ANY CATEGORICAL VALUE GT NOCAT, CAP THE VISIBILITY C AT VISMAX MI. CANNOT USE TABLE( , ) BECAUSE J WOULD BE C OUTSIDE IT. THIS WOULD BE AN ERROR; J SHOULD NOT C EXCEED NOCAT. SAFETY FEATURE. ELSEIF(J.LT.1)THEN WRITE(KFILDO,130)XDATA(K),NOCAT XDATA(K)=1.01 TEST(K)=XDATA(K) C MAKE THE CATEGORY THE BOTTOM OF 1. THIS SHOULD NOT C HAPPEN. SAFETY FEATURE. FD2(K)=0. ELSE R=TABLE(2,J)-TABLE(1,J) C D WRITE(KFILDO,135)J,TABLE(1,J),TABLE(2,J),XDATA(K),R D135 FORMAT(' AT 135 IN VISMBO--J,TABLE(1,J),TABLE(2,J),', D 1 'XDATA(K),R',I4,4F10.3) C FD2(K)=MIN((XDATA(K)-J)*R+TABLE(1,J),VISMAX) C CAP THE VISIBILITY AT VISMAX MI. THIS HAS MEANING ONLY C FOR CATEGORY NOCAT. THE INCOMING NCAT VALUE CAN BE SET C TO GIVE ABOUT THE DESIRED DISTRIBUTION OF FORECASTS ABOVE C 6 MI, MOST OF WHICH SHOULD BE VISMAX. C CCCCD WRITE(KFILDO,136)K,J,XDATA(K),FD2(K),R CCCCD136 FORMAT(' AT 136 IN VISMBO--K,J,XDATA(K),FD2(K),R',2I4,3F10.3) C C THE FACT THAT FOR SOME DEFINITIONS OF THE CATEGORIES, C THE UPPER LIMIT IS NOT INCLUDED AND SOME ARE, MAKES C GETTING IN THE CORRECT CATEGORY DIFFICULT. C THIS CHECK IN CASE A SCALED VALUE IS JUST OUTSIDE THE C CATEGORY WHEN IT SHOULD BE IN. THE ERROR AT 139 C SHOULD NOT OCCUR. PACKING FOR VIS KEEPS 2 DECIMAL PLACES, C SO THOUSANDTHS WON'T SURVIVE PACKING. C IF(J.EQ.1)THEN C IF(FD2(K).GE..49)THEN C IN THIS CHECK, A VALUE OF .499 SHOULD END UP LT 0.5. C IF LEFT AT .499, IT WILL BE PACKED AS 0.5. FD2(K)=.49 D WRITE(KFILDO,137)K,J,FD2(K) D137 FORMAT(/' FD2(K) MODIFIED IN VISMBO AT 137--', D 1 'K, J, FD2(K) =',2I6,F10.4) ENDIF C ELSEIF(J.EQ.2)THEN C IF(FD2(K).LT..5)THEN FD2(K)=.51 D WRITE(KFILDO,137)K,J,FD2(K) ELSEIF(FD2(K).GE..99)THEN FD2(K)=.99 D WRITE(KFILDO,137)K,J,FD2(K) ENDIF C ELSEIF(J.EQ.3)THEN C IF(FD2(K).LT.1.)THEN FD2(K)=1.01 D WRITE(KFILDO,137)K,J,FD2(K) ELSEIF(FD2(K).GE.1.99)THEN FD2(K)=1.99 D WRITE(KFILDO,137)K,J,FD2(K) ENDIF C ELSEIF(J.EQ.4)THEN C IF(FD2(K).LT.2.)THEN FD2(K)=2.01 D WRITE(KFILDO,137)K,J,FD2(K) ELSEIF(FD2(K).GE.2.99)THEN FD2(K)=2.99 D WRITE(KFILDO,137)K,J,FD2(K) ENDIF C ELSEIF(J.EQ.5)THEN C IF(FD2(K).LT.3.)THEN FD2(K)=3.01 D WRITE(KFILDO,137)K,J,FD2(K) ELSEIF(FD2(K).GT.5.)THEN FD2(K)=5.01 D WRITE(KFILDO,137)K,J,FD2(K) ENDIF C ELSEIF(J.EQ.6)THEN C IF(FD2(K).LE.5.01)THEN FD2(K)=5.01 D WRITE(KFILDO,137)K,J,FD2(K) ELSEIF(FD2(K).GT.6.)THEN FD2(K)=6.01 D WRITE(KFILDO,137)K,J,FD2(K) ENDIF C ELSEIF(J.EQ.7)THEN C IF(FD2(K).LE.6.01)THEN FD2(K)=6.01 D WRITE(KFILDO,137)K,J,FD2(K) ENDIF C ELSE WRITE(KFILDO,139)K,J,FD2(K) 139 FORMAT(/' ****ERROR AT 139 IN VISMBO, K, J, FD2(K) =', 1 2I6,F10.4) ISTOP(1)=ISTOP(1)+1 ENDIF C ENDIF C IF(FD2(K).GT.CAP)THEN WRITE(KFILDO,159)K,CCALL(K),FD2(K),CAP 159 FORMAT(' AT 159 IN VISMBO--)K,CCALL(K),FD2(K),CAP', 1 I6,2X,A8,2F10.3) ENDIF C 160 CONTINUE C C WRITE THE SORTED VISIBILITIES. IWORK( ) HAS THE ORDER C FROM THE CALLING PROGRAM SCAVIS. NOTE THAT FOR C IWORK( ) TO HAVE THE ORDER, SORTBG MUST HAVE BEEN C ACTIVATED IN SCLVIS. C D WRITE(KFILDO,162)(K,CCALL(IWORK(K)),TEST(IWORK(K)), D 1 FD2(IWORK(K)),K=1,NSTA) D162 FORMAT(/' SORTED VISIBILITIES'/ D 1 ' NUMBER STATION SCALED CATEGORIES SCALED', D 2 ' VISIBILITIES',/,(I6,4X,A8,F12.3,F19.3)) C C AT THIS POINT, FD2( ) HOLDS THE FORECASTS IN MILES, C SCALED WITHIN CATEGORIES WITH THE PROBABILITIES. C CCCCD WRITE(KFILDO,165)IDPARS(12),IBEND,(FD2(K),K=1,NSTA) CCCCD165 FORMAT(/,' IN VISMBO AT 165--IDPARS(12),IBEND,FD2(K)',2I4/, CCCCD 1 (15F8.2)) C C MODIFY BY OBSERVATIONS IF DESIRED. C IF(IDPARS(12).LT.IBEND)THEN C C RETRIEVE THE OBS. THE ID COMES FROM THE U405A.CN C FILE, ENTRY 7. C CALL GFETCH(KFILDO,KFIL10,IDOBS,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD3,NSTA, 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,170)(IDOBS(M1),M1=1,4) 170 FORMAT(/' ****COULD NOT FIND VISIBILITY OBS', 1 3I10.9,I10,'. CONTINUING WITHOUT OBS', 2 ' MODIFICATION.') C DO 173 K=1,NSTA XDATA(K)=FD2(K) 173 CONTINUE C KER=1 IER=0 GO TO 200 ENDIF C ELSE C DO 175 K=1,NSTA XDATA(K)=FD2(K) 175 CONTINUE C GO TO 200 C USE OF OBS FOR THIS PROJECTION NOT USED. ENDIF C CCCC WRITE(KFILDO,176)(K,CCALL(K),FD2(K),FD3(K),K=1,NSTA) CCCC 176 FORMAT(/,' IN VISMBO AT 176--K,CCALL(K),FD2(K),FD3(K)',/, CCCC 1 (' ',I6,2X,A8,2F10.2)) C IF(IBEND.NE.IBSTRT)THEN RANGE=IBEND-IBSTRT R=(IDPARS(12)-IBSTRT)/RANGE ELSE R=1 C THIS R SHOULD NOT BE NEEDED. DEFINED FOR SAFETY. ENDIF C WRITE(KFILDO,177)IDPARS(12) 177 FORMAT(' VISIBILITY BEING ADJUSTED BY OBS AT', 1 ' PROJECTION =',I4) C DO 180 K=1,NSTA C IF(FD2(K).LT.9998.5)THEN C FD2( ) IS FORECAST IN MILES. C IF(FD3(K).GT.9998.5)THEN C FD3( ) IS OB IN MILES. CCCCD WRITE(KFILDO,1775)K,FD2(K) CCCCD1775 FORMAT(' STATION NUMBER K =',I6, ' CAPPING FORECAST', CCCCD 1 F10.2,' AT VISMAX MI. NO OB AVAILABLE.') C IF THE OB IS MISSING, THE FORECAST IS CAPPED C AT VISMAX MILES. XDATA(K)=MIN(FD2(K),VISMAX) GO TO 180 ENDIF C ELSE GO TO 180 C WHEN THE FORECAST IS MISSING, THE BELOW IS NOT C DONE. THAT IS, WHEN THERE IS NO FORECAST, THE C OB IS NOT SUBSTITUTED. ENDIF C J=XDATA(K) C THIS TRUNCATES THE ORIGINAL CATEGORICAL FORECAST TO THE C CATEGORY NUMBER J. A VALUE OF 2.0 TO 2.99 SHOULD GO C INTO CATEGORY 2. C D WRITE(KFILDO,178)K,RANGE,R,J,XDATA(K),FD3(K), D 1 TABLE(1,J),TABLE(2,J),IDPARS(12) D178 FORMAT(/' AT 178--K,RANGE,R,J,XDATA(K),FD3(K),', D 1 'TABLE(1,J),TABLE(2,J),IDPARS(12)', D 2 I4,2F8.2,I3,4F6.2,I3) C IF(J.LT.NOCAT)THEN C IF(FD3(K).GE.TABLE(1,J).AND.FD3(K).LT.TABLE(2,J))THEN C THE OB IS IN THE FORECAST RANGE. C IF(IDPARS(12).LE.IBSTRT)THEN C USE THE OB AT AND BEFORE PROJECTION IBSTRT. XDATA(K)=FD3(K) C VISIBILITIES ARE PACKED TO HUNDREDTHS, AND THAT C LEVEL OF PRECISION WILL BE RETAINED. ELSEIF(IDPARS(12).LT.IBEND)THEN C THE OB IS IN THE FORECAST RANGE, SO WEIGHT C AVERAGE THE FORECAST AND THE OB, SUCH THAT C AT THE LOW END, THE OB IS USED, AND AT THE C HIGH END, THE FORECAST IS USED. XDATA(K)=R*FD2(K)+(1.-R)*FD3(K) ELSE C THE PROJECTION IS OUTSIDE THE IBSTART-IBEND RANGE. C USE THE FORECAST. XDATA(K)=FD2(K) ENDIF C ELSE C THE OB IS NOT IN THE FORECAST RANGE, SO USE THE FORECAST. XDATA(K)=FD2(K) ENDIF C ELSE C IF(FD3(K).GE.TABLE(1,J))THEN C TREAT THE UPPER CATEGORY AS OPEN ENDED, EXCEPT CAP IT C AT VISMAX. C CCCC WRITE(KFILDO,1785)K,FD2(K),FD3(K),VISMAX CCCC 1785 FORMAT(/' AT 1785 IN VISMBO--FD2(K),FD3(K),VISMAX', CCCC 1 I6,3F10.2) C IF(IDPARS(12).LE.IBSTRT)THEN C THE PROJECTION IS BEFORE ISTART, SO USE THE C FORECAST, BUT CAPPED AT VISMAX. XDATA(K)=MIN(FD3(K),VISMAX) C DATA WERE PACKED, SO EXACT OBS (E.G., 10) MAY C NOT BE EXACTLY 10. PRESERVE THE OB, ALTHOUGH C IT WILL BE PACKED ON OUTPUT AND MAY NOT THEN C BE EXACT. CCCC WRITE(KFILDO,1786)K,XDATA(K) CCCC 1786 FORMAT(' AT 1786 IN VISMBO--K,XDATA(K)',I6,F10.2) ELSEIF(IDPARS(12).LE.IBEND)THEN C THE PROJECTION IS WITHIN THE IBSTART-IBEND RANGE, C SO WEIGHT AND CAP IT. XDATA(K)=MIN(R*FD2(K)+(1.-R)*FD3(K),VISMAX) C CCCC WRITE(KFILDO,1787)K,XDATA(K) CCCC 1787 FORMAT(' AT 1787 IN VISMBO--K,XDATA(K)',I6,F10.2) ELSE XDATA(K)=FD2(K) CCCC WRITE(KFILDO,1788)K,XDATA(K) CCCC 1788 FORMAT(/' AT 1788 IN VISMBO--K,XDATA(K)',I6,F10.2) ENDIF C ELSE C THE OB IS NOT IN THE FORECAST RANGE, SO USE THE FORECAST. XDATA(K)=FD2(K) CCCC WRITE(KFILDO,1789)K,FD2(K),FD3(K),XDATA(K) CCCC 1789 FORMAT(/' AT 1789 IN VISMBO--K,FD2(K),FD3(K),XDATA(K)', CCCC 1 I6,3F10.2) ENDIF C ENDIF C CCCC WRITE(KFILDO,179)K,CCALL(K),XDATA(K),FD2(K),FD3(K) CCCC 179 FORMAT(' AT 179 IN VISMBO--K,CCALL(K),XDATA(K),FD2(K),FD3(K)', CCCC 1 I6,2X,A8,3F9.2) C 180 CONTINUE C CCCC WRITE(KFILDO,186)(K,CCALL(K),FD2(K),FD3(K),XDATA(K),K=1,NSTA) CCCC 186 FORMAT(/,' IN VISMBO AT 186--K,CCALL(K),FD2(K),FD3(K),XDATA(K)',/, CCCC 1 (' ',I6,2X,A8,3F10.2)) C 200 CONTINUE C C COMPUTE THE FREQUENCIES. NOTE THAT THE FREQUENCIES ARE C TO EVEN MILES (EXCEPT THE FIRST) AND DO NOT TRY TO MATCH C THE CATEGORY VALUES. THE TEST IS ON LE, SO THE LISTED C VALUE IS THE HIGH END OF THE CATEGORY, INCLUSIVELY. C TOTAL=0. C DO 220 K=1,NSTA IF(XDATA(K).GE.9998.9)GO TO 220 C DO 218 J=1,15 C IF(XDATA(K).LE.FREQ(J))THEN IFREQ(J)=IFREQ(J)+1 GO TO 219 ENDIF C 218 CONTINUE C GO TO 220 C OTHERWISE, THIS WOULD ALSO COUNT MISSINGS. C 219 TOTAL=TOTAL+1 220 CONTINUE C IF(TOTAL.EQ.0.)THEN WRITE(KFILDO,225) 225 FORMAT(/' ERROR IN VISMBO. TOTAL = 0.') ISTOP(1)=ISTOP(1)+1 GO TO 240 ENDIF C DO 230 J=1,15 RFREQ(J)=IFREQ(J)/TOTAL 230 CONTINUE C WRITE(KFILDO,231) 231 FORMAT(/' FREQUENCIES OF FCSTS IN DISCRETE CATEGORIES', 1 ' INCLUSIVE FROM THE MILES PRINTED DOWN TO, BUT', 2 ' NOT INCLUDING THE NEXT LOWER VALUE.') WRITE(KFILDO,232)(FREQ(J),J=1,15) 232 FORMAT(/' LE MILES ',15F7.2,' TOTAL') WRITE(KFILDO,233)(IFREQ(J),J=1,15),NINT(TOTAL) 233 FORMAT(' FREQUENCIES',15I7,I9) WRITE(KFILDO,234)(RFREQ(J),J=1,15) 234 FORMAT(' REL FREQ ',15F7.2) C C SCALING NECESSARY ONLY WHEN CONST NE 1 OR NSCAL NE 0. C THIS IS ONLY FOR OUTPUT; ALL COMPUTATIONS MADE IN MILES C LIKELY NO SCALING IS TO BE DONE. C IF(CONST.NE.1.OR.NSCAL.NE.0)THEN C FACTOR=CONST*10.**NSCAL C WRITE(KFILDO,237)FACTOR 237 FORMAT(/' SCALING FACTOR =',E12.5,' IS BEING USED IN VISMBO.') C DO 238 K=1,NSTA C IF(XDATA(K).LT.9998.5)THEN XDATA(K)=XDATA(K)*FACTOR ENDIF C 238 CONTINUE C ENDIF C 240 IF(IER.EQ.0)THEN C IF(KER.EQ.1)THEN IER=666 ENDIF C ENDIF C CALL TIMPR(KFILDO,KFILDO,'END VISMBO ') RETURN END