SUBROUTINE CATMLG(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,CCALL,ISDATA,ND1,NSTA,P,ND2X3,NXY, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 PROB,MTANDS,NBLOCK,NFETCH, 6 IS0,IS1,IS2,IS4,ND7, 7 L3264B,L3264W,ISTOP,IER) C C MARCH 2016 GLAHN MDL MOS-2000 C BASED ON CATGR1 C JULY 2016 SCHNAPP CHANGED 123 TO 888 IN ACCORDANCE WITH C STANDARDS FOR CIG > 12,000 FT C JULY 2018 GLAHN MODIFIED CATMLD VERSION WRITTEN FOR C PSEUDO STATIONS TO U755 GRIDDED C MAY 2019 GLAHN REVISED TO HANDLE MISSING THRESHOLDS C FOR A CATEGORY (ALL ZERO FORECATS) C C PURPOSE C TO COMPUTE THE BEST CATEGORY FROM A SET OF PROBABILITY C FORECASTS USING THRESHOLDS. CURRENTLY DEALS WITH: C --CUMULATIVE PROBABILITIES FROM BELOW, THRESHOLDS FROM C BELOW C THE VARIABLE IDS COMPUTED ARE: C 228130095 -- VISIBILITY C 228080095 -- CEILING C C DEVELOPED TO DEAL WITH THE MELD CEILING AND VISIBILITY C PROBABILITIES OF UP TO MAXCAT CATEGORIES. ALSO TO MAKE C SURE THAT A MELD CATEGORY TRIPPED THAT IS BELOW A LAMP C CATEGORY IS NOT CONSIDERED TRIPPED UNLESS THE LAMP C CATEGORY IS TRIPPED. C C THE THRESHOLDS ARE FOR STATIONS, BUT THE FORECASTS C ARE FOR GRIDPOINTS. C C THE VALUES RETURNED IN P( ) ARE THE ACTUAL VALUES C (VIS IN MILES, CIG IN 100'S OF FT) FORECAST, WHICH IN C THE CASE OF EVALUATION AT GRIDPOINTS, ARE THE VALUES C TO GIVE THE GRIDPOINTS. THE VALUES CORRESPOND TO WHAT C WOULD HAVE BEEN OBSERVED TO GIVE THAT CATEGORY. FOR C INSTANCE, CIG CAT 4 WITH A THRESHOLD OF 3.5 MEANS C < 400 FT HAS ONLY ONE REPORTABLE VALUE BELOW 400 AND C ABOVE THE NEXT LOWER CATEGORY, SO THAT VALUE = 3 C (HDS FT) IS PUT ON THE GRID. C C DATA SET USE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (OUTPUT) C KFIL10 - UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS. C (INPUT-OUTPUT) C IP12 - INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C STATIONS ON THE INPUT FILES WILL BE PRINTED TO C THE FILE WHOSE UNIT NUMBER IS IP12. (OUTPUT) C KFILRA(J) - THE UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES C ARE AVAILABLE (J=1,NUMRA). (INPUT) C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (INPUT) C KFIL10 = UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS. C (INPUT) C IP12 = INDICATES WHETHER (>0) OR NOT (=0) THE LIST OF C STATIONS ON THE EXTERNAL RANDOM ACCESS FILES C WILL BE LISTED TO UNIT IP12 (IN CONST/ C FINDST). (INPUT) C KFILRA(J) = THE UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES C ARE AVAILABLE (J=1,NUMRA). (INPUT) C RACESS(J) = THE FILE NAMES ASSOCIATED WITH KFILRA(J) C (J=1,NUMRA). C (CHARACTER*60) (INPUT) C NUMRA = THE NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (INPUT) C ID(J) = THE VARIABLE ID (J=1,4) FOR WHICH THE BEST C CATEGORY IS DESIRED. THIS IS THE CATEGORICAL C ID. (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE ID CORRESPONDING TO ID( ) (J=1,15). C (INPUT) 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 IN C 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 JD(J) = THE BASIC INTEGER VARIABLE ID (J=1,4). C THIS IS THE SAME AS ID(J), 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 JD( ) IS USED TO IDENTIFY THE BASIC MODEL C FIELDS AS READ FROM THE ARCHIVE. (INPUT) C ITAU = THE FORECAST PROJECTION. NOT USED. (INPUT) C NDATE = THE DATE/TIME FOR WHICH FORECAST CATEGORY IS C NEEDED. (INPUT) C CCALL(K) = 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT C LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE C OUTPUT FOR. (CHARACTER*8) (INPUT) C ISDATA(K) = WORK ARRAY (K=1,ND2X3). (INTERNAL) C ND1 = SIZE OF YDATA( ) AND CCALL( ). (INPUT) C NSTA = NUMBER OF STATION CALL LETTERS IN CCALL( ). C (INPUT) C P(K) = THE CATEGORICAL GRIDPOINT FORECAST VALUES C RETURNED (K=1,NXY). (OUTPUT) C ND2X3 = SIZE OF ARRAYS. (INPUT) C NXY = NUMBER OF VALUES TO CALCULATE = SIZE OF GRID. C (INPUT) C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN C INTEGER VARIABLE (L=1,L3264W) (K=1,ND5). THIS C ARRAY IS USED TO READ THE STATION DIRECTORY FROM C A MOS-2000 EXTERNAL FILE. EQUIVALENCED TO C CCALLD( ). (CHARACTER*8) (INTERNAL) C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). EQUIVALENCED C TO ICALLD( , ). (INTERNAL) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(K) = WORK ARRAY (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ). C (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). (INPUT-OUTPUT) C L=1,4--THE 4 ID'S FOR THE DATA. C L=5 --LOCATION OF STORED DATA. WHEN IN CORE, C THIS IS THE LOCATION IN CORE( ) WHERE C THE DATA START. WHEN ON DISK, C THIS IS MINUS THE RECORD NUMBER WHERE C THE DATA START. C L=6 --THE NUMBER OF 4-BYTE WORDS STORED. C L=7 --2 FOR DATA PACKED IN TDL GRIB, 1 FOR NOT. C L=8 --THE DATE/TIME OF THE DATA IN FORMAT C YYYYMMDDHH. C L=9 --NUMBER OF TIMES DATA HAVE BEEN RETRIEVED. C L=10 --NUMBER OF THE SLAB IN DIR( , ,L) AND C IN NGRIDC( ,L) DEFINING THE C CHARACTERISTICS OF THIS GRID. C L=11 --THE NUMBER OF THE PREDICTOR IN THE SORTED C LIST IN ID( ,N) (N=1,NPRED) FOR WHICH C THIS VARIABLE IS NEEDED, WHEN IT IS C NEEDED ONLY ONCE FROM LSTORE( , ). C WHEN IT IS NEEDED MORE THAN ONCE, THE C VALUE IS SET = 7777. C L=12 --USED INITIALLY IN ESTABLISHING C MSTORE( , ). LATER USED AS A WAY OF C DETERMINING WHETHER TO KEEP THIS C VARIABLE. C ND9 = THE SECOND DIMENSION OF LSTORE( , ). (INPUT) C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , ) C THAT ARE IN USE. (INPUT) C CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA C IDENTIFIED IN LSTORE( , ) (J=1,ND10). WHEN C CORE( ) IS FULL DATA ARE STORED ON DISK. C (INPUT) C ND10 = DIMENSION OF CORE( ). (INPUT) C XPROB(J,NN) = THE NN (NN=1,MTANDS) ARRAYS TO HOLD THE PARTIAL C AND THEN THE FINAL PROBABILITY FORECASTS FOR C THE WHOLE GRID (J=1,NXY). (INTERNAL) C MTANDS = THE NUMBER OF PREDICTANDS = THE NUMBER OF C CATEGORIES. (INPUT) C NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM C DISK FILE. (INPUT) C NFETCH = THE NUMBER OF TIMES GFETCH HAS BEEN ENTERED. C GFETCH KEEPS TRACK OF THIS AND RETURNS THE C VALUE. (INPUT/OUTPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,22+). C (INTERNAL) C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C (INTERNAL) C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C (INTERNAL) C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C NOT ALL LOCATIONS ARE USED. (INPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C CALCULATED BY PARAMETER, BASED ON L3464B. C (INPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C (OUTPUT) C LD(J) = HOLDS THE 4 ID WORDS OF THE DATA RETRIEVED INTO C YDATA( ) (J=1,4). (INTERNAL) C LDPARS(J) = PARSED VALUES CORRESPONDING TO LD( ) (J=1,15) C (INTERNAL) C NDIM = DIMENSION OF ITABLE. C YDATA(K) = WORK ARRAY (K=1,ND1) WHICH HOLDS STATION C THRESHOLDS. (AUTOMATIC) C JDATA(K) = BEST CATEGORY WHILE COMPUTING (K=1,ND2X3). C (AUTOMATIC) C JDATAT(K) = USED IN CONJUNCTION WITH JDATA(K) IN OBTAINING C THE CATEGORY. (AUTOMATIC) C ITABLE(I,J) = I=1--VALUE OF CCCFFF ACCOMMODATED--THE C CATEGORICAL FORECASTS. C I=2--ID(1) FOR THRESHOLDS; C I=3--NOT USED; LEFT IN HERE FOR A POSSIBLE C FUTURE IMPLEMENTATION; C I=4--NUMBER OF THRESHOLDS AND THE NUMBER OF C PROBABILITY FORECASTS NEEDED; C I=5--HOW THE CATEGORICAL FORECASTS ARE TO BE C DETERMINED C 2 = FORECASTS ARE CUMULATIVE FROM BELOW AND C THRESHOLDS ARE DETERMINED CUMULATIVE C FROM BELOW C I=6--KEY REPRESENTING THE TIME SLICING: C 1 = 1 SEASON, ALL YEAR, VALUE = 19 C 2 = TWO SEASONS, APR-SEPT, OCT-MAR, C VALUES = 17, 18 C 3 = FOUR SEASONS, MARCH-MAY, JUNE-AUG, ETC. C VALUES = 13, 14, 15, 16 C 4 = EACH MONTH, VALUES = 1-12 C 5 = LMP TSTM 3 SEASON CYCLE, C MARCH 16-JUNE 30, JULY 1-OCT 15, C OCT 16-MARCH 15 C VALUES = 22,20,21 C 6 = LMP PTYPE 2 SEASON CYCLE, SEPT-MAY, C JUNE-AUG. VALUES = 23,14 C I=7,6+ITABLE(2,J)--THE THRESHOLDS FOR THE C PROBABILITY FORECASTS (THE FIRST 6 DIGITS C OF ID(4). NOTE THAT THESE ARE IN THE EXACT C FORM IN ID(4) AND ARE ENTERED IN THE ORDER C USED IN THE COMPUTATION. C (J=1,NDIM). C WITH M THRESHOLDS PROVIDED FOR, M+1 CATEGORIES C ARE POSSIBLE. WHEN THE ACTUAL NUMBER OF C CATEGORIES, ITABLE(4, ), IS < MAXCAT, THEN ONLY C THE FIRST NUMBER NEEDED HAVE LEGITIMATE VALUES C IN ITABLE( , ) AND THE REST CAN BE ZERO. C (INTERNAL) C LMPCAT(I,J) = INDICATES WHETHER (=1) OR NOT (=0) THE C THRESHOLD I,J IN ITABLE(I,J) IS A LAMP C CATEGORY (I=1,MAXCAT) (J=1,NDIM). (INTERNAL) C CATMEL(I,J) = THE VALUE TO PUT ON THE GRID WHEN THE THRESHOLD C ITABLE(I,J) IS MET (I=1,MAXCAT) AND THE C DEFAULT WHEN NO THRESHOLD IS MET (I=MAXCAT+1) C (J=1,NDIM). (INTERNAL) C NCAT = THE NUMBER OF THRESHOLDS AND NUMBER OF C PROBABILITY FORECASTS NEEDED FOR COMPUTATION. C SET = ITABLE(4, ). (INTERNAL) C L2L2TB(N,J) = VALUES FOR L2L2 IN ID(2) FOR THE THRESHOLDS C CORRESPONDING TO MONTH (N=1,12) AND TIME C SLICE FOR COMPUTING THRESHOLDS (J=1,6). C (SEE TDL ON 00-1; P. 14.2) (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C PRSID1 CONST W3TAGE C PARAMETER (NDIM=2) PARAMETER (MAXCAT=24) C CHARACTER*8 CCALL(ND1) CHARACTER*8 CCALLD(ND5) CHARACTER*60 RACESS(5) C DIMENSION P(ND2X3),PROB(NXY,MTANDS) DIMENSION YDATA(ND1),JDATA(NXY),JDATAT(NXY) C YDATA( ), JDATA( ), AND JDATAT( ) ARE AUTOMATIC ARRAYS. DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10),ICALLD(L3264W,ND5) DIMENSION LD(4),LDPARS(15),MD(4),MDPARS(15),KFILRA(5) DIMENSION ITABLE(MAXCAT+6,NDIM) DIMENSION LMPCAT(MAXCAT,NDIM) DIMENSION CATMEL(MAXCAT+1,NDIM) DIMENSION L2L2TB(12,6) C DATA ((ITABLE(I,J),I=1,MAXCAT+6),J=1,NDIM)/ c C BELOW FOR LAMP VIS LAMP+HRRR OR LAMP+RAP MELD, 16 CATS C DD 95 = LAMP+HRRR c 1 228160095, 808130295, 000000000, 16, 2, 2, C 2 500052, 245000, 495000, 745000, 950000, 149501, 3 195001, 249501, 295001, 300501, 400501, 505001, 4 605001, 700501, 800501, 999501, 0, 0, 5 0, 0, 0, 0, 0, 0, C C BELOW FOR LAMP CIG LAMP+HRRR OR LAMP+RAP MELD, 24 CATS C DD 95 = LAMP+HRRR C 6 228080095, 808070295, 000000000, 24, 2 ,2, C 7 950052, 150001, 250001, 350001, 450001, 550001, 8 650001, 750001, 850001, 950001, 115002, 145002, 9 165002, 195002, 245002, 305002, 405002, 495002, A 655002, 805002, 905002, 100503, 110503, 120503/ C DATA ((LMPCAT(I,J),I=1,MAXCAT),J=1,NDIM)/ c C BELOW FOR LAMP VIS LAMP+HRRR MELD, 16 CATS C DD 95 = LAMP+HRRR c 2 0, 0, 1, 0, 1, 0, 3 1, 0, 1, 0, 0, 1, 4 1, 0, 0, 1, 0, 0, 5 0, 0, 0, 0, 0, 0, C C BELOW FOR LAMP CIG LAMP+HRRR MELD, 24 CATS C DD 95 = LAMP+HRRR C 7 0, 1, 0, 0, 1, 0, 8 0, 0, 0, 1, 0, 0, 9 0, 1, 0, 1, 0, 0, A 1, 0, 0, 0, 0, 1/ C DATA ((CATMEL(I,J),I=1,MAXCAT+1),J=1,NDIM)/ C C BELOW FOR LAMP VIS LAMP+HRRR MELD, 16 CATS !LAST VALUE IS DEFAULT IF NO THRESHOLD MET C DD 95 = LAMP+HRRR C 2 .0, .125, .25, .5, .75, 1.12, 3 1.62, 2., 2.5, 3.0, 4.0, 5., 4 6., 7., 8., 9., 10.01, 0., 5 0., 0., 0., 0., 0., 0., X 0., C C BELOW FOR LAMP CIG LAMP+HRRR MELD, 24 CATS !LAST VALUE IS DEFAULT IF NO THRESHOLD MET C DD 95 = LAMP+HRRR C 7 0., 1., 2., 3., 4., 5., 8 6., 7., 8., 9., 11., 13., 9 15., 18., 22., 27., 35., 45., A 58., 73., 85., 95. ,110., 120., X 888./ C X 123./ DATA L2L2TB 1 /19,19,19,19,19,19,19,19,19,19,19,19, 2 18,18,18,17,17,17,17,17,17,18,18,18, 3 16,16,13,13,13,14,14,14,15,15,15,16, 4 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12, 5 22,22,22,20,20,20,21,21,21,21,22,22, 6 23,23,23,23,23,14,14,14,23,23,23,23/ C IER=0 C CALL TIMPR(KFILDO,KFILDO,'START CATMLG ') C DO 100 JJ=1,NDIM C IF(ITABLE(1,JJ).EQ.ID(1))GO TO 1075 C THIS DEFINES THE ELEMENT JJ. 100 CONTINUE C WRITE(KFILDO,107)(ID(L),L=1,4) 107 FORMAT(' ****CATMLG ENTERED FOR VARIABLE', 1 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 2 ' NOT ACCOMMODATED.') CALL W3TAGE('CATMLG') STOP 107 C 1075 IF(ITABLE(5,JJ).NE.2)THEN C THE VALUE IN THE TABLE MUST INDICATE THRESHOLDING C FROM BELOW. WRITE(KFILDO,108)ITABLE(5,JJ),(ID(J),J=1,4) 108 FORMAT(/,' ****ITABLE(5, ) =',I4,' OUT OF RANGE IN ', 1 'CATMLG. CANNOT COMPUTE BEST CATEGORY FOR', 2 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3) CALL W3TAGE('CATMLG') STOP 108 C ELSEIF(ITABLE(6,JJ).GT.6)THEN WRITE(KFILDO,109)ITABLE(6,JJ),(ID(J),J=1,4) 109 FORMAT(/,' ****ITABLE(6, ) =',I4,' OUT OF RANGE IN ', 1 'CATMLG. CANNOT COMPUTE BEST CATEGORY FOR', 2 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3) CALL W3TAGE('CATMLG') STOP 109 C ENDIF C C ZERO THE JDATA( ) AND JDATAT( ) ARRAYS WHICH WILL C HOLD THE CATEGORY DURING THE COMPUTATION. C DO 111 K=1,NXY JDATA(K)=0 JDATAT(K)=0 111 CONTINUE C NCAT=ITABLE(4,JJ) NCYCLE=NDATE-(NDATE/100)*100 C NCYCLE IS L1L1 IN ID(2) MONTH=NDATE/10000-(NDATE/1000000)*100 C MONTH DETERMINES L2L2 IN ID(2) FOR THRESHOLDS. L2L2=L2L2TB(MONTH,ITABLE(6,JJ)) C C L2L2 IS THE L2L2 IN ID(2) FOR THRESHOLDS. ADJUST L2L2 FOR C SPLIT MONTHS IN THREE-SEASON MODEL FOR TSTMS. C NDAY=MOD(NDATE,10000)/100 IF(MONTH.EQ.03.AND.L2L2.EQ.22.AND.NDAY.GE.16) THEN L2L2=20 ELSEIF(MONTH.EQ.10.AND.L2L2.EQ.21.AND.NDAY.GE.16) THEN L2L2=22 ENDIF C LD(1)=ITABLE(2,JJ) LD(2)=NCYCLE*1000000+L2L2*10000 LD(3)=IDPARS(12) C LD( ) IS FOR ACCESSING THE THRESHOLDS. C C START LOOP FOR NCAT THRESHOLDS AND FORECASTS. C USE THE THRESHOLDS AND FORECASTS IN THE ORDER C SPECIFIED IN ITABLE( ,JJ). C DO 200 N=1,NCAT C C COMPUTE ID(4) FOR THE THRESHOLDS. THE FIRST 3 IDS DO NOT C CHANGE FROM CATEGORY TO CATEGORY. C LD(4)=ITABLE(N+6,JJ)*1000+IDPARS(13)*100+IDPARS(14)*10+IDPARS(15) C CCCC WRITE(KFILDO,1115)JJ,N,ITABLE(N+6,JJ),IDPARS(14),IDPARS(14), CCCC 1 IDPARS(15),LD(4) CCCC 1115 FORMAT(/' AT 1115--JJ,N,ITABLE(N+6,JJ),IDPARS(14),IDPARS(14),', CCCC 1 'IDPARS(15),LD(4)',2I4,I13,3I4,I13) C C C FETCH THE THRESHOLDS IN YDATA( ). C CALL PRSID1(KFILDO,LD,LDPARS) C CCCC WRITE(KFILDO,112)NSTA,NDATE,JJ,NCAT,NCYCLE,MONTH,L2L2,NDAY,LD CCCC 112 FORMAT(/'AT 112--NSTA,NDATE,JJ,NCAT,NCYCLE,MONTH,L2L2,NDAY,LD', CCCC 1 I5,I13,10I10) c C THIS SEARCH IS FOR CUMULATIVE FROM BELOW. FOR CUMULATIVE C FROM ABOVE, THE SEARCH ORDER WOULD HAVE TO BE FROM TOP TO C BOTTOM. C C THE THRESHOLDS ARE VECTOR BY STATION. C CCCC WRITE(KFILDO,113)(LD(J),J=1,4),LDPARS(1),(KFILRA(J),J=1,NUMRA) CCCC 113 FORMAT('(LD(J),J=1,4),IDPARS(1),(KFILRA(J),J=1,NUMRA)',4I12,7I6) CALL CONST(KFILDO,KFIL10,IP12, 1 LD,LDPARS,LD,NDATE, 2 KFILRA,RACESS,NUMRA, 3 CCALL,ICALLD,CCALLD, 4 ISDATA,YDATA,ND1,NSTA, 5 IPACK,IWORK,DATA,ND5, 6 LSTORE,ND9,LITEMS,CORE,ND10,LASTL, 7 NBLOCK,LASTD,NSTORE,NFETCH, 8 IS0,IS1,IS2,IS4,ND7, 9 ISTAV,L3264B,L3264W,IER) C YDATA( ) CONTAINS THE THRESHOLDS FOR THE STATIONS IN C CCALL( ). ALL WITHIN A REGION ARE THE SAME, C EXCEPT SOME MAY BE MISSING (=9999.), AND ONLY ONE IS C NEEDED. IT IS USED FOR THE ENTIRE GRID. C IF(IER.NE.0)THEN WRITE(KFILDO,117)(LD(J),J=1,4),IER 117 FORMAT(/' ****DID NOT FIND THRESHOLDS IN CATMLG FOR ', 1 3I10.9,I10.3,'. IER =',I4,'.'/' CATEGORICAL ', 2 'FORECASTS CANNOT BE MADE. MAJOR ERROR.', 3 ' STOP AT 117.') CALL W3TAGE('CATMLG') STOP 117 ELSE WRITE(KFILDO,120)(LD(J),J=1,4) 120 FORMAT(' RETRIEVED THRESHOLD ',3I10.9,I10.3) C CCCC WRITE(KFILDO,121)(YDATA(J),J=1,NSTA) CCCC 121 FORMAT(/' AT 121--(YDATA(J),J=1,NSTA)'/(15F9.3)) ENDIF C FOUND THRESHOLD. THESE WERE DEVELOPED FOR STATIONS AND C ALL ARE THE SAME, BUT SOME CAN BE MISSING = 9999. C FIND A NON-MISSING VALUE. C TRESH=9999. C DO 130 K=1,NSTA C IF(YDATA(K).LT..9989)THEN C AN 888 INDICATES A MISSING THRESHOLD. u830 HAS PRODUCED C A THRESHOLD OF .999 WHEN PROBABILITIES WERE MISSING. TRESH=YDATA(K) C CCCC WRITE(KFILDO,125)TRESH,(LD(J),J=1,4) CCCC 125 FORMAT(' THRESHOLD =', F6.3, ' FOR ',3I10.9,I10.3) GO TO 140 C ENDIF C 130 CONTINUE C WRITE(KFILDO,135)N,(ID(J),J=1,3),LD(4) 135 FORMAT(/' ****DID NOT FIND A NON-MISSING THRESHOLD IN CATMLG.', 1 ' DID NOT MAKE CATEGORY ',I4, 2 ' FORECASTS FOR ',3I10.9,I10.3) C THIS MAY BE CAUSED BY A CATEGORY OF ALL ZERO PROBABILITIES C FORECASTS AND MISSING THRESHOLDS. NORMALLY WOULD HAPPEN C WITH THE LOWEST CATEGORY. IF IT HAPPENED FOR AN C INTERMEDIATE LEVEL, THAT CATEGORY WOULD JUST NOT BE MADE. ISTOP=ISTOP+1 GO TO 200 C C THE PROBABILITIES ARE IN PROB( , ). THE THRESHOLDS ARE C RETRIEVED ONE AT A TIME IN YDATA( ). C 140 DO 160 K=1,NXY C IF(JDATA(K).EQ.0)THEN C ONCE JDATA( ) HAS BEEN SET NE 0, IT IS NOT CHANGED AGAIN. C IF(NINT(PROB(K,N)).EQ.9999)THEN C IF ANY FORECAST IS TRULY MISSING, THE BEST CATEGORY C IS SET MISSING. JDATA(K)=9999 ELSEIF(NINT(TRESH).EQ.9999)THEN C IF ANY THRESHOLD IS MISSING, THE BEST CATEGORY C IS SET MISSING. JDATA(K)=9999 ELSE C IF(ITABLE(5,JJ).EQ.2)THEN C ALTHOUGH CATMLG CURRENTLY DEALS WITH ONLY CUMULATIVE C FROM BELOW, THE TEST IS LEFT HERE, AS IN CATGR1, IN C CASE OTHER ALTERNATIVES ARE CONSIDERED LATER. C C THIS SECTION FOR CUMULATIVE FROM BELOW PROBABILITIES, C THE ONLY ONE CURRENTLY CONSIDERED. C IF(PROB(K,N).GE.TRESH)THEN C THE THRESHOLD IS TRIPPED. C IF(LMPCAT(N,JJ).EQ.0)THEN C THIS IS NOT A LAMP CATEGORY. DO NOT SET C JDATA(K) = N OR THE PROCESSING WILL STOP FOR C STATION K. C IF(JDATAT(K).EQ.0)THEN JDATAT(K)=N ENDIF C ELSE C THIS IS A LAMP CATEGORY. JDATA(K)=N C IF(JDATAT(K).EQ.0)THEN JDATAT(K)=N ENDIF C JDATA(K)=JDATAT(K) C JDATAT(K) IS THE CATEGORY FIRST TRIPPED, AFTER C THE NEXT LOWER LAMP CATEGORY. ENDIF C ELSE C IF(LMPCAT(N,JJ).EQ.0)THEN C THIS IS NOT A LAMP CATEGORY. IT DID NOT C TRIP THE THRESHOLD, SO SET JDATAT(K) = 0. C CCCC IF(JDATAT(K).NE.0)THEN CCCC WRITE(KFILDO,140)CCALL(K),JDATA(K),JDATAT(K) CCCC 140 FORMAT(' AT 140 IN CATMLG--CCALL(K),', CCCC 1 'JDATA(K),JDATAT(K),PROB(K,N) ',A8,2I4) CCCC ENDIF C JDATAT(K)=0 JDATA(K)=0 ENDIF C ENDIF C ENDIF C ENDIF C ENDIF C 160 CONTINUE C 200 CONTINUE C C SET P( ) TO THE CATEGORY IN JDATA( ). C DO 210 K=1,NXY C IF(JDATA(K).EQ.9999)THEN C JDATA(K) = 9999 INDICATES A MISSING FORECAST OR THRESHOLD. P(K)=9999. ELSEIF(JDATA(K).EQ.0)THEN P(K)=CATMEL(NCAT+1,JJ) ELSE P(K)=CATMEL(JDATA(K),JJ) ENDIF C 210 CONTINUE C RETURN END