SUBROUTINE SCLCIG(KFILDO,KFIL10,IP16,NDATE,ID,IDPARS,JD, 1 IDOBS,XDATA,FD2,FD3,ND1,NSTA, 2 NCAT,CONST,NSCALE, 3 IBSTRT,IBEND,CAP,PREX4,MOSFUL, 4 LSTORE,ND9,LITEMS, 5 IS0,IS1,IS2,IS4,ND7, 6 IPACK,IWORK,DATA,ND5, 7 CORE,ND10,NBLOCK,NSTORE,NFETCH, 8 L3264B,ISTOP,IER) C C AUGUST 2009 GLAHN TDL MOS-2000 C ADAPTED FROM SCLQ12 C DECEMBER 2009 GLAHN CHANGED SCALING FROM CONTINUOUS C OUTPUT TO FRACTIONS OF CATEGORIES C DECEMBER 2009 GLAHN MODIFIED; ELIMINATED SOME VARIABLES C FROM CALL C DECEMBER 2009 GLAHN ADDED FD3( ) TO CALL; MODIFIED TO C SCALE UPPER CATEGORY 8 C MARCH 2009 GLAHN CORRECTED CATEGORY NCAT C MARCH 2011 GLAHN ADDED CALL TO CIGMBO C MARCH 2011 GLAHN REMOVED FACTOR C MARCH 2011 GLAHN CHANGED DO 100 LOOP FROM J=1,NCAT TO C J=1,NCAT-1 PLUS ASSOCIATED CHANGES; C ADDED NCAT TO CALL TO CIGMBO C APRIL 2011 GLAHN ADDED IDOBS( ),IP16 C APRIL 2011 GLAHN ADDED ICUM; REVISED TO USE EITHER C INCOMING CUMULATIVE PROBABILITIES C OR DIFFERENCE AND USE DISCRETE C APRIL 2011 GLAHN ADDED ICVMMOS PROBABILITIES TO ITABLE C APRIL 2011 GLAHN REMOVED ICVLM C APRIL 2011 GLAHN ADJUSTED FOR PROBABILITIES PROVIDED C BY CVLMPM C MAY 2011 GLAHN REMOVED ICUM; ADDED IC C MAY 2011 GLAHN SENTENCE IN PURPOSE REMOVED C SEPTEMBER 2015 GLAHN CHANGED +.001 TO +.01 ABOVE 170 C SEPTEMBER 2015 GLAHN COMMENTS C SEPTEMBER 2015 GLAHN ROUNDING TO 2 PALCES ABOVE 17 AND C CHANGED CHECKING C FEBRUARY 2015 GLAHN ADDED MOSFUL TO CALL, AND USED IT C NOVEMBER 2018 GLAHN ADDED PREX4 TO CALL C C PURPOSE C TO SCALE THE VALUES IN A CATEGORY OF CEILING HEIGHT 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 HUNDREDS OF FEET FT (UNLESS CONST AND C NSCAL DICTATE OTHERWISE). FINALLY, THEN MULTIPLY TIMES A C CONST*10**NSCALE. THE NUMBER OF PROBABILITY CATEGORIES C IS NCAT. NCAT MUST EQUAL IDCAT-1. HIGHER PROBABILITIES C INDICATE LOWER VALUES IN THE CATEGORY, EXCEPT FOR THE UPPER C CATEGORY WHERE NO SCALING IS DONE. THE INPUT IS A WHOLE C NUMBER CATEGORY; THE OUTPUT IS CEILING HEIGHT IN C HUNDREDS OF FEET. C C THIS WAS WRITTEN FOR LAMP CEILING HEIGHT, 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 CIG 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, CIGMBO (CEILING HEIGHT MODIFIED BY C OBS) IS CALLED TO PUT THE SCALED CATEGORIES INTO FEET C FOR ANALYSIS. THE RUN TIME OBSERVATIONS CAN BE USED C TO PERSIST THE ACTUAL HEIGHTS 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 IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL OR RANCOM ACCESS C FILE. (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 IP16 = UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL OR RANCOM ACCESS C FILE. (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 CEILING HEIGHT OBSERVATIONS C (ACTUALLY COMPUTED) FOR PERSISTENCE C AUGMENTATION (J=1,4). (INPUT) C XDATA(K) = CATEGORICAL VALUES ON INPUT; SCALED VALUES C IN HUNDREDS OF FEET ON OUTPUT (K=1,NSTA). C (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 CEILING HEIGHT 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 CEILING HEIGHT CATEGORY 8 IN THE C ANALYSIS. (INPUT) C PREX4 = WHEN 0, NO ADDED SCALING; C WHEN = 1, SQUARE FOOT SCALING. 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 SCLCIG 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 C COMPUTATIONS. (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 NSTORE = NUMBER OF TIMES A RECORD HAS BEEN STORED TO C INTERNAL STORAGE. (INPUT/OUTPUT) C NFETCH = NUMBER OF TIMES A RECORD HAS BEEN FETCHED FROM C INTERNAL STORAGE. (INPUT/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 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 LASTL = THE LAST LOCATION IN CORE( ) USED. RETURNED C FROM GSTORE. (INTERNAL) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK C IN INTERNAL RANDOM ACCESS STORAGE. RETURNED C FROM GSTORE. (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 CEILING C HEIGHT CATEGORY (J=IDCAT) FOR LAMP (L=1) AND C FOR MOS (L=2). THE IDCAT ENTRY IS THE C 4-WORD ID OF THE VARIABLE BEING PROCESSED C SANS THE DD AND TAU (E.G., THE CATEGORICAL C VARIABLE). THESE ARE CUMULATIVE PROBABILITIES C FROM BELOW FOR LAMP. HOWEVER, MOS HAS BEEN C POSTPROCESSED TO DISCRETE PROBABILITIES. IF C MOS WERE TO CHANGE TO THEIR ORIGINAL FORM OF C CUMULATIVE, CHANGE ITABLE( , ,2) AND IT SHOULD C WORK. (INTERNAL) C IC = 0 FOR LAMP CUMULATIVE ROBABILITES; C 1 FOR MOS DISCRETE PROBABILITIES, LABLED AS C LAMP. C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GFETCH C PARAMETER (IDCAT=9) C DIMENSION ID(4),IDPARS(15),JD(4),IDOBS(4) DIMENSION XDATA(ND1),FD2(ND1),FD3(ND1) 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/208070200,0,0,150001000, 2 208070200,0,0,450001000, 3 208070200,0,0,950001000, 4 208070200,0,0,195002000, 5 208070200,0,0,305002000, 6 208070200,0,0,655002000, 7 208070200,0,0,120503000, 8 208070200,0,0,999994000, 9 208071000,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 208070300,1,0,150001000, B 208070300,1,0,450001000, C 208070300,1,0,950001000, D 208070300,1,0,195002000, E 208070300,1,0,305002000, F 208070300,1,0,655002000, G 208070300,1,0,120503000, H 208070300,1,0,999994000, I 208071000,0,0,000000000/ C THE ABOVE ARE FOR NCAT-1 MOS DISCRETE PROBABILITIES. THE C IDCAT VALUE IS NOT USED. C 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 SCLCIG--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 SCLCIG. 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 SCLCIG.', 1 ' CANNOT PROCESS VARIABLE ',I9.9,I10.9,I10.9,I4.3, 2 '. IER =',I3) GO TO 900 ENDIF C C FIND THE NCAT-1 PROBABILITIES AND SCALE. THE CATEGORICAL C VALUES ARE IN XDATA( ) ON INPUT AND WILL BE MODIFIED. C D WRITE(KFILDO,113)ND1,NSTA,(IDPARS(M1),M1=1,15) D113 FORMAT(/' AT 113--,ND1,NSTA,(IDPARS(M1),M1=1,15)', D 1 2I12/(15I8)) C D WRITE(KFILDO,114)IBSTRT,IBEND,CAP,(K,XDATA(K),K=1,100) D114 FORMAT(/' IN SCLCIG AT 114--IBSTRT,IBEND,CAP,',2I4,F6.2/ D 1 (8(I7,F8.2))) C C SET FD2( ) = 9999. C DO 115 K=1,NSTA FD2(K)=9999. 115 CONTINUE C IC=0 C IC = 0 MEANS THE PROBABILITIES LOOKED FOR ARE CUMULATIVE C FROM BELOW. C IC = 1 MEANS THE PROBABILITIES LOOKED FOR ARE DISCRETE. C DO 200 J=1,NCAT-1 C PROBABILITIES ARE AVAILABLE FOR NCAT-1 CATEGORIES. C NOTHING IS KNOWN INSIDE CATEGORY NCAT = 8, SO SAVE IT AT ITS C ORIGINAL VALUE. C C TRANSFER CUMULATIVE PROBABILITIES FROM DATA( ) TO FD3( ). C IF(J.GT.1)THEN C C SAVE PREVIOUS PROBS. NOT NEEDED IF DISCRETE. 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 SCLCIG 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 D WRITE(KFILDO,125)(K,DATA(K),K=1,100) D125 FORMAT(/,' IN SCLCIG 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 IF(IC.EQ.0)THEN C C DISCRETE PROBABILITIES ARE MUST BE COMPUTED. C TRUE LAMP PROBABILITIES ARE CUMULATIVE FROM BELOW, C BUT PSEUDO LAMP PROBABILITIES (ACTUALLY MOS C INTERPOLATED AS NECESSARY TO HOURLY VALUES) ARE C DISCRETE. 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 C DISCRETE PROB FOR CATEGORY J = CUMULATIVE PROB C FOR CAT J MINUS CUMULATIVE PROB FOR CAT J-1. C DO 135 K=1,NSTA FD3(K)=DATA(K)-FD3(K) 135 CONTINUE C ENDIF C ELSE C C DATA( ) HOLDS DISCRETE PROBABILITIES, WHICH ARE C TO BE USED IN SCALING. C DO 140 K=1,NSTA FD3(K)=DATA(K) 140 CONTINUE C ENDIF C C FIND THE MAX AND MIN PROBABILITY FOR THIS CATEGORY. C XMAX=-99999. XMIN=99999. D ICOUNT=0 C DO 150 K=1,NSTA C IF(NINT(FD3(K)).EQ.9999)GO TO 150 C CHECKING THE PROBABILITY. IT IS POSSIBLE THERE COULD C BE MISSING PROBABILITIES EVEN THOUGH THE CATEGORICAL. C VALUE IS THERE. C IF(NINT(XDATA(K)).EQ.J)THEN 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 CCCC IF(J.EQ.2)THEN CCCC WRITE(KFILDO,1495)XDATA(K),FD3(K),XMAX,XMIN,ICOUNT CCCC 1495 FORMAT(' IN SCLCIG AT 1495--XDATA(K),FD3(K),XMAX,XMIN', CCCC 1 'ICOUNT',4F12.3,I7) CCCC ENDIF C 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 D WRITE(KFILDO,160)XMAX,XMIN,RANGE,A,B D160 FORMAT(/,' IN SCLCIG AT 160--XMAX,XMIN,RANGE,A,B', D 1 5F10.3) C XMAXJ=J+.99 C XMAXJ IS USED TO KEEP THE CATEGORY FROM GOING INTO C THE NEXT HIGHER CATEGORY. C DO 170 K=1,NSTA 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 SCLCIG UP TO THIS POINT. C J ONLY GOES UP TO NCAT-1. C FD2(K)=MIN(A-B*FD3(K),XMAXJ) 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 IF(J.EQ.2)THEN CCCC WRITE(KFILDO,165)J,K,A,B,FD3(K),XDATA(K),FD2(K) CCCC 165 FORMAT(' AT 165--J,K,A,B,FD3(K),XDATA(K),FD2(K)', CCCC 1 2I6,5F10.3) CCCC ENDIF C ENDIF C 170 CONTINUE C D WRITE(KFILDO,175)(K,FD2(K),XDATA(K),K=1,10) D175 FORMAT(' AT 175--K,FD2(K),XDATA(K)',/,(I8,2F10.3)) C 200 CONTINUE C C THE COMPUTATIONS WERE IN FD2( ); PUT THEM IN XDATA( ). C DO 210 K=1,NSTA C IF(NINT(XDATA(K)).NE.NCAT)THEN C CATEGORY NCAT WAS NOT SCALED ABOVE. 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 SCLCIG UP TO THIS POINT. XDATA(K)=FD2(K) D ELSE D WRITE(KFILDO,205)K,XDATA(K) D205 FORMAT(' AT 205--K,XDATA(K)',I8,F10.3) ENDIF C 210 CONTINUE C C THE CEILING HEIGHT FORECASTS ARE NOW IN CATEGORIES SCALED C WITHIN THE CATEGORY BY THE PROBABILITY OF THE CATEGORY. C NOW CALL CIGMBO TO PUT THE SCALED CATEGORIES INTO C CEILING HEIGHT IN HUNDREDS OF FT (UNLESS CONST AND C NSCAL DICTATE OTHERWISE) AND MODIFY BY THE OBS WHEN THE C FORECAST FALLS WITHIN THE CATEGORY, DEPENDING ON C THE FORECAST PROJECTION IDPARS(12). C CALL CIGMBO(KFILDO,KFIL10,IP16,NDATE,ID,IDPARS,JD, 1 IDOBS,XDATA,FD2,FD3,ND1,NSTA, 2 NCAT,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,NSTORE,NFETCH, 8 L3264B,ISTOP,IER) C C SCALE BY SQUARE ROOT WHEN PREX4 = 1. C IF(NINT(PREX4).EQ.1)THEN C DO 215 K=1,NSTA C IF(XDATA(K).LT.9998..AND.XDATA(K).GE.0.)THEN XDATA(K)=SQRT(XDATA(K)) ENDIF C 215 CONTINUE C ENDIF C D WRITE(KFILDO,225)(K,XDATA(K),K=1,100) D225 FORMAT(/,' IN SCLCIG AT 225',/,(8(I7,F8.2))) C 900 RETURN END