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