SUBROUTINE SCLSKY(KFILDO,KFIL10,NDATE,ID,IDPARS,JD, 1 IDCIG,XDATA,XP,YP,FD2,FD3, 2 CCALL,ND1,NVAL,RAD, 3 NX,NY,NCAT,CONST,NSCALE, 4 NPROJ,ALATL,ALONL,ORIENT,XLAT,MESH,ITRPX, 5 LSTORE,ND9,LITEMS, 6 IS0,IS1,IS2,IS4,ND7, 7 IPACK,IWORK,DATA,ND5, 8 CORE,ND10,NBLOCK,NFETCH,MISTOT, 9 L3264B,ISTOP,IER) C C MARCH 2007 GLAHN MDL MOS-2000 C MARCH 2007 GLAHN CHANGED TABLE TO CORRECT VALUES C APRIL 2007 SMB CHANGED FLOAT FUNCTIONS TO REAL. C ADDED COMMA TO FORMAT STATEMENT. C MAY 2007 SMB COMMENTED OUT WRITE STATEMENT AT C 100 FOR OPERATIONS C MAY 2007 GLAHN MODIFIED /D TO NOT PRINT WHEN C ENTRY IS FOR A GRID C AUGUST 2007 GLAHN INCREASED RANGE OF L FROM 2 TO 4 C ACCOUNT FOR LAMP C OCTOBER 2008 COSGROVE ADDED COMMAS FOR IBM COMPILE C NOVEMBER 2008 GLAHN MADE NINT TEST ON DATA( ) AT DO 150; C 2X PUT IN FORMAT AT 165; INSERTED C NINT(DATA(K).EQ.9999)GO TO 170 C AT DO 170 C NOVEMBER 2008 GLAHN CORRECTION TO MIDDLE CATEGORY; C CHECKED FOR SMALL RANGE. C NOVEMBER 2008 GLAHN REMOVED CHECK FOR SMALL RANGE. C OCTOBER 2009 GLAHN REMOVED INCREMENTING ISTOP(1) C WHEN IER RETURNED NE 0 C APRIL 2011 GLAHN RETOOLED TO HANDLE EITHER DISCRETE C OR CUMULATIVE PROBABILITIES C JUNE 2011 IM CHANGED GO TO 1490 TO GO TO 1491 C BELOW 119; CHANGED 1490 TO 1491; C ASSIGNED 1490 IN IF(LB.EQ.2);CORRECTED C ALL OF DATA() TO FD3() BELOW 1491; C CORRECTED FD2(K) COMPUTATION FORMULA C FOR J.EQ.3. C JULY 2014 HUANG ADDED "C"S IN FRONT OF "D" STATEMENTS C FOR OPERATIONS; RE-COMMENTED OUT C WRITE STATEMENT AT 100 FOR OPERATIONS C C PURPOSE C TO SCALE THE VALUES IN A CATEGORY OF A VARIABLE C ACCORDING TO THE PROBABILITY RANGE FOR THIS CASE C OVER THE DATA BEING ANALYZED, THEN TIMES A FACTOR = C CONST*10**NSCALE. THE PROBABILITIES CAN BE EITHER C DISCRETE (NCAT CATEGORIES) OR CUMULATIVE FROM BELOW C (NCAT-1) CATEGORIES. THIS ROUTINE WILL HANDLE EITHER C VECTOR DATA OR GRIDDED. IT WILL HANDLE OPAQUE OR TOTAL C SKY, AND ITABLE( , , ) COVERS BOTH. C C NOTE THIS IS SPECIFIC TO SKY COVER. FOR THE LOWER TWO C CATEGORIES, HIGH PROBABILITIES ARE SCALED TO THE LOW END C OF THE RANGE OF COVERAGE. FOR THE HIGHER TWO, HIGH C PROBABILITIES RE SCALED TO THE HIGH END OF THE RANGE OF C THE COVERAGE. THE MIDDLE CATEGORY IS SPLIT; WHEN THE C PROBABILITY IS > THE MIDDLE PROBABILITY, THE HIGHER C PROBABILITIES INDICATE HIGH COVERAGE; WHEN THE C PROBABILITY IS < THE MIDDLE PROBABILITY, THE HIGHER C PROBABILITIES INDICATE LOW COVERAGE. C C THE IDS ARE THE SAME FOR MOS AND LAMP (EXCEPT FOR THE C DD). IT IS NOT KNOWN FROM THE CATEGORICAL ID IN C ITABLE( , ,6) WHETHER THE PROBABILITIES ARE DISCRETE C OR CUMULATIVE, SO READING FROM GFETCH MUST BE TRIED C TO DETERMINE. C C NOTE THAT THE "FINAL" SCALING TO PERCENT COVERAGE IS DONE C IN SCLSKY RATHER THAN IN SKYMBO. THIS IS IN DISTINCTION C TO CEILING AND VISIBILITY WHERE SCLCIG AND SCLVIS SCALES C WITHIN CATEGORIES, AND CIGMBO AND VISMBO PUT IN TERMS C OF THE "FINAL" VALUES OF FEET AND MILES, RESPECTIVEY. C THE "FINAL FINAL" SCALING WITH CONST AND NSCALE IS DONE C IN SKYMBO, AS WELL AS CIGMBO AND VISMBO. TO DO THIS, C FACTOR = 100. IS USED. THE NSCALE AND CONST THEN C OPERATE ON PERCENT COVERAGE. 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) = 4-WORD ID OF VARIABLE TO PROVIDE FIRST GUESS FOR 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 IDCIG = THE FIRST WORD OF THE CEILING HEIGHT TO C USE IN CHECKING CONSISTENCY. IT COMES FROM C U405A.CN ITABLE(1,7). (INPUT) C XDATA(K) = CATEGORICAL VALUES ON INPUT; SCALED VALUES C ON OUTPUT (K=1,NVAL). (INPUT/OUTPUT) C XP(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AREA AT THE CURRENT GRID MESH C LENGTH XMESH. (INPUT) C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AREA AT THE CURRENT GRID MESH C LENGTH XMESH. (INPUT) C FD2(K) = WORK ARRAY (K=1,NVAL). (INTERNAL) C FD3(K) = WORK ARRAY (K=1,NVAL). (INTERNAL) C CCALL(K) = CALL LETTERS OF STATIONS WHEN ENTRY IS FOR C VECTOR DATA (NX = 0) (J=1,NVAL). WHEN C ENTRY IS FOR A GRID, CCALL( ) IS DUMMY. C (INPUT) C ND1 = FIRST DIMENSION OF XDATA( ) AND DIMENSION C OF FD1( ). (INPUT) C NVAL = NUMBER OF STATIONS BEING USED; THE NUMBER C OF VALUES IN XDATA( ). (INPUT) C RAD = R(1) IN U405A, THE RADIUS OVER WHICH TO C SEARCH FOR A CLOSE STATION. (INPUT) C NX = THE X-EXTENT OF THE GRID NEEDED WHEN A GRID C IS BEING ACCESSED; OTHERWISE, MUST BE ZERO. C SCLSKY CAN BE USED FOR EITHER VECTOR DATA C OR GRIDDED DATA. WHEN GRIDDED, THE GRID C MUST BE PUT ONTO THE GRID BEING USED BY C THE CALLING PROGRAM. (INPUT) C NY = THE Y-EXTENT OF THE GRID NEEDED WHEN A GRID C IS BEING ACCESSED. (SEE NX ABOVE.) (INPUT) C NCAT = NUMBER OF PROBABILITY CATEGORIES. (INPUT) C CONST = THE MULTIPLIER FOR SCALING THE CATEGORICAL C OUTPUT. (INPUT) C NSCALE = THE POWER OF TEN FOR SCALING THE CATEGORICAL C OUTPUT. (INPUT) C NPROJ = NUMBER OF MAP PROJECTION TO WHICH THIS GRID C APPLIES. C 3 = LAMBERT. C 5 = POLAR STEREOGRAPHIC. C 7 = MERCATOR. C (INPUT) C ALATL = LATITUDE IN DEGREES OF THE LOWER LEFT CORNER C POINT (1,1) OF THE ANALYSIS GRID. (INPUT) C ALONL = LONGITUDE (WEST) IN DEGREES OF THE LOWER LEFT C CORNER POINT OF THE ANALYSIS GRID. (INPUT) C ORIENT = ORIENTATION W LONGITUDE, PARALLEL TO GRID C COLUMNS, IN DEGREES. (INPUT) C XLAT = N LATITUDE AT WHICH THE MESH LENGTH APPLIES. C (INPUT) C MESH = NOMINAL MESH LENGTH OF THE GRID NEEDED. NOT C ACTUALLY USED FOR VECTOR DATA. (INPUT) C ITRPX = THE TYPE OF INTERPOLATION BEING USED. C (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 MISTOT = RUNNING TOTAL OF RETRIEVED GRIDS WITH ONE OR C MORE MISSING VALUES. (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 FOR C VECTOR AND FSTGS5 FOR GRID). (INPUT/OUTPUT) C IER = ERROR CODE. C 0 = GOOD RETURN. C 103 = COULD NOT IDENTIFY ID IN INTERNAL TABLE. C 777 = WHEN A CALLED ROUTINE DID NOT FURNISH C AN IER. 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 ITABLE(I,J,L) = HOLDS THE 4-WORD IDS OF THE NCAT PROBABILITIES C (I=1,4) (J=1,NCAT) (L=1,8). THE THIRD C DIMENSION IS TO ACCOMMODATE BOTH THE DATA TO C ANALYZE (L=1,3,5) AND THE FIRST GUESS (L=2,4,6). C THE IDCAT ENTRY IS THE 4-WORD ID OF THE C VARIABLE BEING PROCESSED SANS THE DD AND TAU C (E.G., THE CATEGORICAL VARIABLE). (INTERNAL) C TABLE(I,J) = HOLDS THE LOWER AND UPPER CATEGORY VALUES OF C THE VARIABLES WHOSE IDS ARE IN ITABLE( , , ) C (I=1,2), (J=1,NCAT-1). (SEE ITABLE( , , )) FOR C MORE EXPLANATION. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C SZGRDM, GFETCH, CKGRID, LMLLIJ, PSLLIJ, MCLLIJ, NOMINL, C CUTIT C PARAMETER (IDCAT=6) C CHARACTER*8 CCALL(ND1) C DIMENSION ID(4),IDPARS(15),JD(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,8),LD(4),TABLE(2,IDCAT-1) C DATA ITABLE/208380200,0,0,150001000, 1 208380200,0,0,250001000, 2 208380200,0,0,400001000, 3 208380200,0,0,700001000, 4 208380200,0,0,999905000, 5 208381000,0,0,0, C THE ABOVE ARE FOR OPAQUE SKY VECTOR, CUMULATIVE PROBABILITIES. C 6 218380200,0,0,150001000, 7 218380200,0,0,250001000, 8 218380200,0,0,400001000, 9 218380200,0,0,700001000, A 218380200,0,0,999905000, B 218381000,0,0,0, C THE ABOVE ARE FOR OPAQUE SKY GRIDDED, CUMULATIVE PROBABILITIES. C C 208350200,0,0,150001000, D 208350200,0,0,250001000, E 208350200,0,0,400001000, F 208350200,0,0,700001000, G 208350200,0,0,999905000, H 208351000,0,0,0, C THE ABOVE ARE FOR TOTAL SKY VECTOR, CUMULATIVE PROBABILITIES. C I 218350200,0,0,150001000, J 218350200,0,0,250001000, K 218350200,0,0,400001000, L 218350200,0,0,700001000, M 218350200,0,0,999905000, N 218351000,0,0,0, C THE ABOVE ARE FOR TOTAL SKY GRIDDED, CUMULATIVE PROBABILITIES. C X 208384300,0,0,150001000, 1 208384300,0,0,250001000, 2 208384300,0,0,400001000, 3 208384300,0,0,700001000, 4 208384300,0,0,999905000, 5 208381000,0,0,0, C THE ABOVE ARE FOR OPAQUE SKY VECTOR, DISCRETE PROBABILITIES. C 6 218384300,0,0,150001000, 7 218384300,0,0,250001000, 8 218384300,0,0,400001000, 9 218384300,0,0,700001000, A 218384300,0,0,999905000, B 218381000,0,0,0, C THE ABOVE ARE FOR OPAQUE SKY GRIDDED, DISCRETE PROBABILITIES. C C 208350300,0,0,150001000, D 208350300,0,0,250001000, E 208350300,0,0,400001000, F 208350300,0,0,700001000, G 208350300,0,0,999905000, H 208351000,0,0,0, C THE ABOVE ARE FOR TOTAL SKY VECTOR, DISCRETE PROBABILITIES. C I 218351300,0,0,150001000, J 218351300,0,0,250001000, K 218351300,0,0,400001000, L 218351300,0,0,700001000, M 218351300,0,0,999905000, N 218351000,0,0,0/ C THE ABOVE ARE FOR TOTAL SKY GRIDDED, DISCRETE PROBABILITIES. C DATA TABLE/ .00,.05, 1 .05,.25, 2 .25,.50, 3 .50,.87, 4 .87,1.0/ C IER=0 C WRITE(KFILDO,100)NX,NY C 100 FORMAT(/' AT 100 IN SCLSKY--NX,NY',2I6) C C DETERMINE WHETHER VARIABLE IS IN THE LIST. 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 CD WRITE(KFILDO,101)NCAT,CONST,NSCALE, CD 1 ((ITABLE(J,NCAT,L),J=1,4),L=1,2) CD101 FORMAT(/' AT 101 IN SCLSKY--CAT,CONST,NSCALE', CD 1 '((ITABLE(J,IDCAT.L),J=1,4),L=1,2',I6,F6.2,I6/ CD 2 (4I11)) CD WRITE(KFILDO,102)(ITABLE(M1,J,1),M1=1,4),(IDPARS(M1),M1=1,15) CD102 FORMAT(/' AT 102--(ITABLE(M1,J,1),M1=1,4),(IDPARS(M1),M1=1,15)', CD 1 4I12/(15I8)) C IF(NCAT.NE.IDCAT-1)THEN WRITE(KFILDO,103)NCAT,IDCAT-1 103 FORMAT(/' ****NCAT = ',I3,' NOT CORRECT IN SCLSKY.', 1 ' SHOULD BE', I3,'. FATAL ERROR.') IER=777 GO TO 900 ENDIF C DO 105 L=1,8 C IF(ID(1).EQ.ITABLE(1,IDCAT,L)+IDPARS(4).AND. 1 ID(2).EQ.ITABLE(2,IDCAT,L).AND. 2 (ID(3)/1000).EQ.(ITABLE(3,IDCAT,L)/1000).AND. 3 ID(4).EQ.ITABLE(4,IDCAT,L))THEN C C THE CATEGORICAL ID HAS BEEN FOUND, BUT MUST CALL GFETCH C TO SEE WHETHER THE PROBABILITIES ARE FOR THIS L. IF NOT, C MUST CONTINUE THE SEARCH. NOTE THAT THE SAME CATEGORICAL C ID GOES WITH BOTH DISCRETE AND CUMULATIVE PROBABILITIES. C LD(1)=ITABLE(1,1,L)+IDPARS(4) C THE DD IS ADDED. LD(2)=ITABLE(2,1,L) LD(3)=ITABLE(3,1,L)+IDPARS(12) C THE TAU IS ADDED. LD(4)=ITABLE(4,1,L) 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 CD ISTOP(3)=ISTOP(3)+1 CD WRITE(KFILDO,120)(LD(M1),M1=1,4) CD104 FORMAT(/' ****COULD NOT FIND PROBABILITY RECORD', CD 1 3I10.9,I10,'. FATAL ERROR IN SCLSKY AT 104.') GO TO 105 C ELSE GO TO 112 C THE L HAS BEEN DEFINED. ENDIF C ENDIF C 105 CONTINUE 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 SCLSKY. IER =',I3) GO TO 900 C C FIND THE NCAT PROBABILITIES AND SCALE. THE CATEGORICAL C VALUES ARE IN XDATA( ) ON INPUT AND WILL BE MODIFIED. C 112 LB=(ITABLE(1,1,L)-(ITABLE(1,1,L)/1000)*1000)/100 C LB IS THE BINARY INDICATOR FOR THE PROBABILITIES. C FACTOR=100. C CD WRITE(KFILDO,113)ND1,NVAL,L,(IDPARS(M1),M1=1,15) CD113 FORMAT(/' AT 113--,ND1,NVAL,L,(IDPARS(M1),M1=1,15)', CD 1 3I12/(15I8)) C CD WRITE(KFILDO,1135)NVAL,FACTOR,(XDATA(M),M=1,NVAL) CD1135 FORMAT(' AT 1135 IN SCLSKY--NVAL,FACTOR,(XDATA(M),M=1,NVAL)', CD 1 I12,F8.2,/,(15F8.1)) C C SET FD2( ) = 9999. C DO 115 K=1,NVAL FD2(K)=9999. 115 CONTINUE C DO 200 J=1,NCAT C CD WRITE(KFILDO,116)J,L,(ITABLE(M1,J,L),M1=1,4) CD116 FORMAT(/' AT 116--J,L,(ITABLE(M1,J,L),M1=1,4)', CD 1 6I12) C C TRANSFER CUMULATIVE PROBABILITIES FROM DATA( ) TO FD3( ). C IF(J.GT.1.AND.LB.EQ.2)THEN C DO 118 K=1,NVAL FD3(K)=DATA(K) 118 CONTINUE C ENDIF C IF(J.EQ.NCAT.AND.LB.EQ.2)THEN C IF THE ABOVE TEST IS MET, THE PROBABILITIES ARE CUMULATIVE C AND, THEREFORE, ONLY NCAT-1 EXIST. THE LAST DISCRETE C CATEGORY MUST BE CALCULATED. C DO 119 K=1,NVAL FD3(K)=1.-DATA(K) 119 CONTINUE C GO TO 1491 ENDIF C C GET THE PROBABILITY OF CATEGORY J. CAN BE A GRID OR VECTOR. C LD(1)=ITABLE(1,J,L)+IDPARS(4) C THE DD IS ADDED. LD(2)=ITABLE(2,J,L) LD(3)=ITABLE(3,J,L)+IDPARS(12) C THE TAU IS ADDED. LD(4)=ITABLE(4,J,L) 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 SCLSKY AT 120.') GO TO 900 ENDIF C IF(NX.EQ.0)GO TO 1490 C WHEN NX NE 0, THIS IS A GRID, AND MUST BE PROCESSED C ONTO THE CORRECT GRID. C IF(MISSP.NE.0)MISTOT=MISTOT+1 C C IF THIS GRID COULD NOT BE OBTAINED OR THE GRID CHARACTERISTICS C WERE NOT WHAT WAS EXPECTED, COUNT IT AS A GRID THAT COULD C NOT BE OBTAINED BY INCREMENTING ISTOP(3). IT IS ALSO A C FATAL ERROR FOR THIS ELEMENT. C C CHECK GRID PARAMETERS. C CALL CKGRID(KFILDO,LD,NPROJ,ORIENT,XLAT,IS2,ND7,IER) C IF(IER.NE.0)THEN ISTOP(3)=ISTOP(3)+1 GO TO 900 ENDIF C C CKGRID ASSURES THE MAP PROJECTION (NPROJ), THE ORIENTATION C (ORIENT), AND THE LATITUDE OF MESH LENGTH (XLAT) ARE C WHAT ARE EXPECTED AND THAT THE MESH LENGTH IS ONE OF C THE PERMISSIBLE ONES. IT IS NOT ASSURED AT THIS POINT C THAT THE LOCATION OF THE GRID, THE MESH LENGTH, OR THE C DIMENSIONS OF THE GRID ARE WHAT ARE WANTED. C C THE INPUT GRID AT ITS SIZE AND LOCATION IS IN DATA( ). C POSITION THIS GRID (WITH THE SAME GRID LENGTH) OVER THE C ANALYSIS AREA. ALATL AND ALONL REFER TO THE MESH C LENGTH MESHB. IS2(8) IS IN MILLIMETERS; PSLLIJ, LMLLIJ, C AND MCLLIJ NEED METERS. IS2(5) AND IS2(6) ARE IN C TENTHS OF MILLIDEGRESS. C IF(NPROJ.EQ.3)THEN CALL LMLLIJ(KFILDO,ALATL,ALONL,IS2(8)/1000.,ORIENT,XLAT, 1 REAL(IS2(5)/10000.),REAL(IS2(6)/10000.), 2 XIFG,YJFG) ELSEIF(NPROJ.EQ.5)THEN CALL PSLLIJ(KFILDO,ALATL,ALONL,IS2(8)/1000.,ORIENT,XLAT, 1 REAL(IS2(5)/10000.),REAL(IS2(6)/10000.), 2 XIFG,YJFG) ELSEIF(NPROJ.EQ.7)THEN CALL MCLLIJ(KFILDO,ALATL,ALONL,IS2(8)/1000.,XLAT, 1 REAL(IS2(5)/10000.),REAL(IS2(6)/10000.), 2 XIFG,YJFG) ELSE WRITE(KFILDO,146)NPROJ 146 FORMAT(/' ****MAP PROJECTION NUMBER NPROJ =',I3, 1 ' NOT 3, 5, OR 7. FATAL ERROR IN SCLSKY AT', 2 ' 146.') IER=777 GO TO 900 ENDIF C CALL NOMINL(KFILDO,IS2(8)/1000000.,MESHI,TRASH,NPROJ,IER) C MESHI IS THE GRID INPUT MESH LENGTH. C IS2(8) IS IN KM*1000000; MESHI IS IN KM. C IF(IER.NE.0)THEN GO TO 900 ENDIF C RATIO=FLOAT(MESH)/MESHI NXI=NINT((NX-1)*RATIO)+1 NYI=NINT((NY-1)*RATIO)+1 NXOFF=NINT(XIFG)-1 NYOFF=NINT(YJFG)-1 C CD WRITE(KFILDO,147)RATIO,MESH,MESHI,NXI,NYI,NXOFF,NYOFF CD147 FORMAT(/' AT 147 IN SCLSKY--', CD 1 'RATIO,MESH,MESHI,NXI,NYI,NXOFF,NYOFF',F8.5,6I8) CD WRITE(KFILDO,1470)XIFG,YJFG,IS2(3),IS2(4) CD1470 FORMAT(' AT 1470 IN SCLSKY--XIFG,YJFG,IS2(3),IS2(4)', CD 1 2F12.5,2I12) C IF(NXOFF.NE.0.OR.NYOFF.NE.0.OR.IS2(3).NE.NXI. 1 OR.IS2(4).NE.NYI)THEN CALL CUTIT(KFILDO,DATA,IS2(3),IS2(4),NXOFF,NYOFF, 1 DATA,NXI,NYI,IER) C IS2(3) AND IS2(4) ARE THE INPUT GRID DIMENSIONS IN C DATA( ). NXI AND NYI ARE THE OUTPUT GRID DIMENSIONS C IN DATA( ). THERE IS NO NEED TO CALL CUTIT IF C THE INPUT AND OUTPUT GRIDS ARE THE SAME. ENDIF C IF(IER.NE.0)THEN GO TO 900 ENDIF C CALL SZGRDM(KFILDO,DATA,NXI,NYI,MESHI,MESH,ITRPX, 1 IS2(3)*IS2(4)) C NXI AND NYI ARE THE DIMENSIONS IN OF THE INPUT C GRID IN DATA( ). THEY ARE CHANGED, IF NECESSARY, TO C BE THE DIMENSIONS OR THE OUTPUT GRID IN DATA( ). THEY C WILL NOW AGREE WITH NX,NY CALCULATED PREVIOUSLY. C IF(NXI.NE.NX.OR.NYI.NE.NY)THEN WRITE(KFILDO,148)NX,NXI,NY,NYI 148 FORMAT(/' ****NX AND NXI =,',2I6,' OR NY AND NYI =',2I6, 1 ' DO NOT AGREE AT 148 IN SCLSKY. FATAL ERROR.') IER=777 GO TO 900 ENDIF C CD WRITE(KFILDO,149)MESHI,MESH,NXI,NYI,NX,NY CD149 FORMAT(/' AT 149 IN SCLSKY--MESHI,MESH,NXI,NYI,NX,NY', CD 1 6I6) C C THE GRID READ IN DATA( ) HAS NOW BEEN PUT ONTO THE SAME C GRID AS THE INCOMING ONE IN XDATA( ), SO THE GRIDPOINTS C MATCH ONE FOR ONE. C C IF THE PROBABILITIES ARE DISCRETE, THEN NO FURTHER C PROCESSING IS NECESSARY. IF THEY ARE CUMULATIVE, C THEY MUST BE DIFFERENCED TO GET DISCRETE (EXCEPT FOR C CATEGORY 1), OR IN THE CASE OF THE LAST CATEGORY, C SUBTRACTED FROM UNITY, WHICH IS DONE ABOVE. C 1490 IF(LB.EQ.2)THEN C C CUMULATIVE PROBABILITIES HAVE BEEN READ. DISCRETE C PROBABILITIES ARE TO BE USED IN SCALING. CALCULATE C THEM. 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,NVAL FD3(K)=DATA(K) 130 CONTINUE C ELSE C DO 135 K=1,NVAL FD3(K)=DATA(K)-FD3(K) 135 CONTINUE C ENDIF C ELSE C C PROBABILITIES ARE DISCRETE, SO TRANSFER TO FD3( ). C DO 140 K=1,NVAL FD3(K)=DATA(K) 140 CONTINUE C ENDIF C C AT THIS POINT, DISCRETE PROBABILITIES EXIST IN FD3( ). C C FIND THE MAX AND MIN PROBABILITY FOR THIS CATEGORY. C 1491 XMAX=-99999. XMIN=99999. CD ICOUNT=0 C DO 150 K=1,NVAL 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 CD 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 CD IF(NX.EQ.0)THEN C NOTE THAT CCALL( ) IS DUMMY WHEN A GRID IS BEING C PROCESSED. NX = 0 FOR VECTOR FD3. CD WRITE(KFILDO,1495)K,CCALL(K),XDATA(K),FD3(K),XMAX,XMIN, CD 1 ICOUNT CD1495 FORMAT(' IN SCLSKY AT 1495--K,CCALL(K),XDATA(K),FD3(K),', CD 1 'XMAX,XMIN,ICOUNT',I6,1X,A8,4F10.3,I7) CD ENDIF C ENDIF C 150 CONTINUE 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 RANGE=XMAX-XMIN C IF(XMAX.EQ.XMIN)THEN C THIS GUARDS AGAINST A SMALL RANGE FOR A DIVISOR. A=(TABLE(2,J)-TABLE(1,J))/2.+TABLE(1,J) B=0. RANGE=0. HALFR=1. HALF=XMAX HTAB=TABLE(1,J)+(TABLE(2,J)-TABLE(1,J))/2. WRITE(KFILDO,1520)A,B,RANGE,HALFR,XMAX,HALF,HTAB 1520 FORMAT(/' AT 1520--A,B,RANGE,HALFR,XMAX,HALF,HTAB', 1 /,7F8.2) C SOME OF THE ABOVE ARE NOT USED FOR THIS SITUATION. C C FOR A CONSTANT VALUE, THE OUTPUT IS THE MIDPOINT C OF THE RANGE IN TABLE( , ). 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. FOR CLOUDS, NEITHER OF THESE C POSSIBILITIES WOULD BE LIKELY TO HAPPEN. ELSE C IF(J.LE.2)THEN C FOR THE LOWEST 2 CATEGORIES, GIVE THE HIGH C PROBABILITIES A LOW VALUE. B=(TABLE(1,J)-TABLE(2,J))/RANGE A=TABLE(2,J)-B*XMIN ELSEIF(J.GE.4)THEN C FOR THE HIGHEST 2 CATEGORIES, GIVE THE HIGH C PROBABILITIES A HIGH VALUE. B=(TABLE(2,J)-TABLE(1,J))/RANGE A=TABLE(1,J)-B*XMIN ELSE C FOR THE MIDDLE CATEGORY, NEED SPECIAL TREATMENT. HALFR=RANGE/2. HALF=XMIN+HALFR HTAB=(TABLE(2,J)-TABLE(1,J))/2. ENDIF C ENDIF C CD WRITE(KFILDO,160)XMAX,XMIN,RANGE, CD 1 TABLE(2,J),TABLE(1,J) CD160 FORMAT(/,' IN SCLSKY AT 160--XMAX,XMIN,RANGE,', CD 1 'TABLE(2,J),TABLE(1,J)',5F10.3) C DO 170 K=1,NVAL C IF(NINT(XDATA(K)).EQ.J)THEN C NOTE CHECKING FOR MISSING XDATA( ) HERE IS NOT NECESSARY. c IF(NINT(FD3(K)).EQ.9999)GO TO 170 C THIS GUARDS AGAINST A PROBABILITY BEING MISSING WHEN C A CATEGORICAL VALUE IS THERE. THIS SHOULD NOT REALLY C HAPPEN, BUT HAS. NOTE THAT FD2( ) HAS BEEN ALREADY C INITIALIZED TO 9999. C IF(J.EQ.3)THEN C THIS IS THE MID CATEGORY AND NEEDS SPECIAL C TREATMENT. HIGH PROBABILITIES HIGHER THAN THE C MIDDLE OF THE RANGE INDICATE HIGH COVERAGE. C HIGH PROBABILITIES LOWER THAN THE MIDDLE C OF THE RANGE INDICATE LOW COVERAGE. C IF(FD3(K).EQ.HALF)THEN IF(RANGE.EQ.0.)THEN FD2(K)=HTAB*FACTOR WRITE(KFILDO,1600)FD3(K),HALF,HTAB,FACTOR,FD2(K) 1600 FORMAT(/,' AT 1600--FD3(K),HALF,HTAB,FACTOR,FD2(K)', 1 /,5F8.2) C THE ABOVE IS THE CASE IN WHICH THE XMAX = XMIN C AND WOULD USUALLY BE WHEN ONLY ONE CASE IN THE C CATEGORY. THE VALUE IS PUT AT THE CENTER. ELSE FD2(K)=(TABLE(1,J)+HTAB)*FACTOR ENDIF ELSEIF(FD3(K).LT.HALF)THEN FD2(K)=(TABLE(1,J)+HTAB+HTAB*(XMIN-FD3(K))/HALFR)*FACTOR ELSE FD2(K)=(TABLE(2,J)-HTAB*(XMAX-FD3(K))/HALFR)*FACTOR ENDIF C ELSEIF(J.EQ.1)THEN C TO BE CONSISTENT WITH CATEGORY DEFINITONS, CATEGORY 1 C IS CLEAR. COMPUTATIONS INVOLVING CATEGOYR 1 C ABOVE COULD BE BYPASSED, BUT ARE INCLUDED IN CASE C SOME OTHER TREATMENT IS DESIRED. THIS TREATMENT C IS CONSISTENT WITH ANALYSIS OF OBS. FD2(K)=0. C ELSEIF(J.EQ.5)THEN C TO BE CONSISTENT WITH CATEGORY DEFINITONS, CATEGORY 5 C IS OVERCAST. COMPUTATIONS INVOLVING CATEGOYR 5 C ABOVE COULD BE BYPASSED, BUT ARE INCLUDED IN CASE C SOME OTHER TREATMENT IS DESIRED. THIS TREATMENT C IS CONSISTENT WITH ANALYSIS OF OBS. FD2(K)=100. C ELSE FD2(K)=(A+B*FD3(K))*FACTOR ENDIF C CD IF(NX.EQ.0)THEN C NOTE THAT CCALL( ) IS DUMMY WHEN A GRID IS BEING C PROCESSED. NX = 0 FOR VECTOR FD3. CD WRITE(KFILDO,165)J,K,CCALL(K),A,B,FD3(K),XDATA(K),FD2(K) CD165 FORMAT(' AT 165--J,K,CCALL(K),A,B,FD3(K),XDATA(K),FD2(K)', CD 1 2I6,2X,A8,5F10.3) CD ENDIF C ENDIF C 170 CONTINUE C 200 CONTINUE C C THE COMPUTATIONS WERE IN FD2( ); PUT THEM IN XDATA( ). C DO 210 K=1,NVAL XDATA(K)=FD2(K) 210 CONTINUE C CD WRITE(KFILDO,215)(K,CCALL(K),XDATA(K),K=1,NVAL) CD215 FORMAT(' AT 215--K,CCALL(K),XDATA(K)'/(I7,2X,A8,F8.2)) C C THE SKY FORECASTS ARE NOW IN CATEGORIES SCALED C WITHIN THE CATEGORY BY THE PROBABILITY OF THE CATEGORY. C NOW CALL SKYMBO TO PUT THE SCALED CATEGORIES INTO C PERCENT COVERAGES AND MODIFY BY THE CEILING HEIGHT C FORECASTS WHEN THERE IS AN INCONSISTENCY. C CALL SKYMBO(KFILDO,KFIL10,NDATE,ID,IDPARS,JD, 1 IDCIG,XDATA,XP,YP,FD2,NVAL, 2 NCAT,CONST,NSCALE,RAD, 3 LSTORE,ND9,LITEMS, 4 IS0,IS1,IS2,IS4,ND7, 5 IPACK,IWORK,DATA,ND5, 6 CORE,ND10,NBLOCK,NFETCH, 7 L3264B,ISTOP,IER) C CD WRITE(KFILDO,225)(XDATA(K),K=1,NVAL) CD225 FORMAT(/,' IN SCLSKY AT 225',/,(15F8.2)) C 900 RETURN END