SUBROUTINE CNVPOTAK(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH, 6 IS0,IS1,IS2,IS4,ND7, 7 L3264B,L3264W,IER) C C MARCH 2011 CHARBA MDL MOS-2000 C MARCH 2011 CHARBA THE CODES FOR THE FOUR CONVECTION POT- C ENTIAL CATEGRIES (NO, LOW, MEDIUM, AND C HIGH) WERE CHANGED FROM 0, 1, 2, AND 3 C TO THE STANDARD VALUES OF 0, 4, 6, AND C 8. C MAY 2011 CHARBA CLEANED UP AND UPGRADED DOCUMENTATION. C JUNE 2011 CHARBA CHANGED TO FINAL ID FOR CONVECTION C POTENTIAL (CHANGED FROM 207563 TO C 207561). C MARCH 2012 CHARBA MODIFIED TO ACCOMMODATE NEW LAMP LTG C POTENTIAL C MAY 2013 CHARBA MODIFIED BECAUSE CONVECTION AND LIGHT- C ING POTENTIAL CCCFFFS WERE CHANGED AND C A Y/N LIGHTNING CATEGORICAL (BASED ON C THE NEW LIGHTNING PROBABILITIES) WAS C ADDED. NOTE THAT ID CHANGES FOR THE C POTENTIAL PRODUCTS WAS DUE TO AN ID C CONFLICT WITH THE CATEGORICAL LIGHT- C PRODUCT. C SEPTEMBER 2020 SAMPLATSKY UPDATED IDS, RENAMED ROUTINE C C PURPOSE C TO COMPUTE MULTIPLE FORECAST POTENTIAL CATEGORIES OF A C NON-OCCURRENCE/OCCURRENCE (0/1) PREDICTAND. A GIVEN POTEN- C TIAL CATEGORY IS PREDICTED WHEN THE FORECAST PROBABILITY C EQUALS OR EXCEEDS A CORRESPONDING PRE-SPECIFIED THRESHOLD C PROBABILITY. CNVPOT IS PRESENTLY CONFIGURED TO HANDLE C FOUR FORECAST POTENTIAL CATEGORIIES (NO, LOW, MEDIUM, AND C HIGH; THREE THRESHOLDS), BUT IT IS EASILY ADAPTED TO HANDLE C UP TO EIGHT CATEGORIES (SEVEN THRESHOLDS). CNVPOT HAS A C SIMILAR STRUCTURE TO CATGR1. C C THE FOLLOWING IDPARS(1) AND IDPARS(2) ARE ACCOMMODATED: C 207 711 - 1-HR AK LIGHTNING POTENTIAL C 207 761 - 1-HR AK CONVECTION POTENTIAL 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. (INPUT) C KFILRA(J) = UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES ARE C AVAILABLE (J=1,NUMRA). (INPUT) C RACESS(J) = FILE NAMES ASSOCIATED WITH KFILRA(J) C (J=1,NUMRA). (CHARACTER*60) (INPUT) C NUMRA = NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (INPUT) C ID(J) = VARIABLE ID (J=1,4) FOR THE RETURNED CONVECTION C POTENTIAL QUANTITY. (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 FIELDS C AS READ FROM THE ARCHIVE. (INPUT) C ITAU = THE NUMBER OF HOURS AHEAD TO FIND A VARIABLE. C THIS HAS ALREADY BEEN CONSIDERED IN MDATE, BUT C IS NEEDED FOR CALL TO RETVEC. (INPUT) C NDATE = THE DATE/TIME OF THE OUTPUT VARIABLE. (INPUT) C MDATE = NDATE UPDATED WITH ITAU( ). (INPUT) C NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT C WITH. (INPUT) C CCALL(K,J) = 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT C LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE C OUTPUT FOR (J=1) AND 5 POSSIBLE OTHER STATION C CALL LETTERS (J=2,6) THAT CAN BE USED INSTEAD C IF THE PRIMARY (J=1) STATION CANNOT BE FOUND C IN AN INPUT DIRECTORY (K=1,NSTA). ALL STATION C DATA ARE KEYED TO THIS LIST, EXCEPT POSSIBLY C CCALLD( ). EQUIVALENCED TO ICALL( , , ). C (CHARACTER*8) (INPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. DIMENSION OF XDATA( ) YDATA( ) AND C JDATA( ). C ISDATA(K) = WORK ARRAY (K=1,ND1). (INTERNAL) C XDATA(K) = HOLDS THE RETURNED VARIABLE (K=1,NSTA). (OUTPUT) C YDATA(K) = WORK ARRAY (K=1,NSTA) WHICH HOLDS THE PROBABIL- C ITY THRESHOLDS. (AUTOMATIC) C JDATA(K) = WORK ARRAY WHICH HOLDS THE PRELIMINARY POTENTIAL C CATEGORY DATA (K=1,NSTA). (AUTOMATIC) C ND5 = DIMENSION OF IPACK( ), IWORK( ), DATA( ), C CCALLD( ), AND SECOND DIMENSION OF ICALLD( , ). C (INPUT) C ICALLD(L,K) = STATION CALL LETTERS (EIGHT 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 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 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. (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 102 = ID NOT ACCOMMODATED OR VALUE IN C ITABLE( , ) IS INCORRECT. C SEE RETVEC FOR OTHER VALUES. (OUTPUT) C LD(J) = VARIABLE ID FOR THE PROBABILITY THRESHOLD DATA C RETRIEVED INTO YDATA( ) (J=1,4). (INTERNAL) C LDPARS(J) = PARSED VALUES CORRESPONDING TO LD( ) (J=1,15) C (INTERNAL) C MD(J) = VARIABLE ID FOR THE FORECAST PROBABILITY DATA C RETRIEVED INTO XDATA( ) (J=1,4). (INTERNAL) C MDPARS(J) = PARSED VALUES CORRESPONDING TO MD( ) (J=1,15) C (INTERNAL) C ITABLE(I,J) = I=1--ID(1) FOR OUTPUT VARIABLE; C I=2--ID(1) FOR PROBABILITY THRESHOLDS; C I=3--ID(1) FOR PROBABILITY FORECASTS; C I=4--NUMBER OF PROBABILITY THRESHOLDS NEEDED; C I=5--PROBABILITIES AND THRESHOLDS CONVENTION: C 1 = PROBABILITIES AND THRESHOLDS ARE CUMU- C LATIVE FROM ABOVE C I=6--TIME OF YEAR KEY FOR PROB THRESHOLDS; C L2L2TB( ,M) VALUE C M=1- ONE SEASON, ALL YEAR; VALUE = 19 C M=2 - TWO SEASONS, APR-SEPT, OCT-MAR; C VALUES = 17, 18 C M=3 - FOUR SEASONS, MARCH-MAY, JUNE-AUG, ETC. C VALUES = 13, 14, 15, 16 C M=4 - EACH MONTH; VALUES = 1-12 C M=5 - THREE SEASONS: C 16 MAR - 30 JUN; VALUE = 20 C 01 JUL - 15 OCT; VALUE = 21 C 16 OCT - 15 MAR; VALUE = 22 C NOTE: ITABLE(6, ) SPECIFIES M IN C L2L2TB(N,M) (SEE BELOW). C I=7,6+ITABLE(4,J)--THE FIRST 6 DIGITS OF LD(4) C OF THE PROBABILITY THRESHOLDS IN THE ORDER C THE LATTER ARE APPLIED TO THE PROBS. C (J=1,NDIM). (INTERNAL) C NOTE: WITH 7 POSSIBLE THRESHOLDS, 8 "POTENTIAL" C CATEGORIES ARE ACCOMMODATED. C L2L2TB(N,M) = VALUES FOR L2L2 IN LD(2) FOR THE PROB THRESHOLDS C CORRESPONDING TO THE MONTH (N=1,12) AND "SEASON" C CONVENTION [M=1,5 AS SPECIFIED BY ITABLE(6, ); C SEE ABOVE]. (INTERNAL) C NCAT = THE NUMBER OF PROBABILITY THRESHOLDS C [=ITABLE(4, )], WHICH EQUALS THE NUMBER OF POT- C ENTIAL CATEGORIES - 1. (INTERNAL) C C NONSYSTEM SUBROUTINES CALLED C RETVEC, PRSID1 C PARAMETER (NDIM=4) C CHARACTER*8 CCALL(ND1,6) CHARACTER*8 CCALLD(ND5) CHARACTER*60 RACESS(5) C DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5),ICALLD(L3264W,ND5) C DIMENSION ISDATA(ND1),XDATA(ND1),YDATA(ND1),JDATA(ND1) C YDATA( ), JDATA( ) ARE AUTOMATIC ARRAYS. C DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION LD(4),LDPARS(15),MD(4),MDPARS(15),KFILRA(5) C DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) C DIMENSION L2L2TB(12,5) C DIMENSION ITABLE(13,NDIM) C DATA ITABLE/207711035,807610135,207710135,3,1,2, ! lamp ltg pot 1 282000,113000,043000,000000,000000,0,0, 3 207711045,807610145,207710145,3,1,2, ! lamp ltg pot 4 282000,113000,043000,000000,000000,0,0, 5 207761035,807660135,207760135,3,1,2, ! lamp cnv pot 6 282000,113000,043000,000000,000000,0,0, 7 207761045,807660145,207760145,3,1,2, ! lamp cnv pot 8 282000,113000,043000,000000,000000,0,0/ C DATA IPDNTH/950000/ C DATA L2L2TB/19,19,19,19,19,19,19,19,19,19,19,19, 1 18,18,18,18,18,17,17,17,17,18,18,18, ! alaska w/c c 1 18,18,18,17,17,17,17,17,17,18,18,18, ! standard w/c 2 16,16,13,13,13,14,14,14,15,15,15,16, 3 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12, 4 22,22,22,20,20,20,21,21,21,21,22,22/ C IER=0 C DO 100 JJ=1,NDIM IF(ITABLE(1,JJ).EQ.ID(1))GO TO 1075 100 CONTINUE C WRITE(KFILDO,107)(ID(L),L=1,4) 107 FORMAT(' ****CNVPOT ENTERED FOR VARIABLE', 1 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 2 ' NOT ACCOMMODATED.') IER=102 GO TO 400 C 1075 IF(ITABLE(5,JJ).GT.4)THEN WRITE(KFILDO,108)ITABLE(5,JJ),(ID(J),J=1,4) 108 FORMAT(/,' ****ITABLE(5, ) =',I4,' OUT OF RANGE IN ', 1 'CNVPOT. CANNOT COMPUTE CONVEC OR LTG POTENTIAL FOR', 2 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3) IER=102 GO TO 400 C ELSEIF(ITABLE(6,JJ).GT.5)THEN WRITE(KFILDO,109)ITABLE(6,JJ),(ID(J),J=1,4) 109 FORMAT(/,' ****ITABLE(6, ) =',I4,' OUT OF RANGE IN ', 1 'CNVPOT. CANNOT COMPUTE CONVECTION POTENTIAL FOR', 2 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3) IER=102 GO TO 400 C ENDIF C C ASSIGN THE DEFAULT CONVECTION/LIGHTNING POTENTIAL TO 0. C DO 111 K=1,NSTA JDATA(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 C L2L2 IS A SEASON CODE, WHICH IS USED TO SPECIFY LD2( ) FOR THE C THRESHOLD PROBS. C L2L2=L2L2TB(MONTH,ITABLE(6,JJ)) C C ADJUST L2L2 FOR SPLIT MONTHS USED IN THREE-SEASON MODEL FOR C LIGHTNING AND CONVECTION. C NDAY=MOD(NDATE,10000)/100 IF(MONTH.EQ.05.AND.L2L2.EQ.18.AND.NDAY.GE.16) THEN L2L2=17 ELSEIF(MONTH.EQ.09.AND.L2L2.EQ.17.AND.NDAY.GE.16) THEN L2L2=18 ENDIF C C LD( ) IS FOR THRESHOLDS; MD( ) FOR PROBS C LD(1)=ITABLE(2,JJ) LD(2)=NCYCLE*1000000+L2L2*10000 LD(3)=IDPARS(12) C MD(1)=ITABLE(3,JJ) MD(2)=0 MD(3)=LD(3) C C START LOOP FOR NCAT PROB THRESHOLDS C DO 200 N=1,NCAT C C SPECIFY LD(4) FOR PROB THRESHOLD N. THE FIRST 3 IDS DO NOT C CHANGE AMONG THE NCAT THRESHOLDS. C LD(4)=ITABLE(N+6,JJ)*1000+IDPARS(13)*100+IDPARS(14)*10+IDPARS(15) C C FETCH THE THRESHOLDS IN YDATA( ). C CALL PRSID1(KFILDO,LD,LDPARS) CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 LD,LDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,YDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH, 6 IS0,IS1,IS2,IS4,ND7, 7 L3264B,L3264W,IER) C C WRITE(KFILDO,110) NDATE,LD,(YDATA(KK),KK=1,NSTA,100) C110 FORMAT(' THS IN CNVPOT, NDATE, LD( ),YDATA( ) = ',5I10,/, C 1 (15F8.3)) C IF(IER.NE.0)THEN WRITE(KFILDO,127)(LD(J),J=1,4),(ID(J),J=1,4) 127 FORMAT(' ****THRESHOLDS',2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 1 ' NOT RETRIEVED BY RETVEC IN CNVPOTAK.', 2 ' CANNOT COMPUTE CONVECTION POTENTIAL FOR',/, 3 ' ',2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 4 ' SET POTENTIAL TO MISSING AND CONTINUE') GO TO 400 C ENDIF C IF(N.GT.1) GO TO 140 C C THE PROBABILITIES ARE FETCHED ONLY FOR FIRST PASS IN LOOP C (N = 1); MD(4) IS SPECIFIED WITH IPDNTH. C MD(4)=IPDNTH*1000+IDPARS(13)*100+IDPARS(14)*10+IDPARS(15) C C FETCH THE PROBABILITIES IN XDATA( ). C CALL PRSID1(KFILDO,MD,MDPARS) CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 MD,MDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH, 6 IS0,IS1,IS2,IS4,ND7, 7 L3264B,L3264W,IER) C C WRITE(KFILDO,130) NDATE,MD,(XDATA(KK),KK=1,NSTA,100) C130 FORMAT(' PROBS IN CNVPOT, NDATE, MD( ),XDATA( ) = ',5I10,/, C 1 (15F8.3)) C IF(IER.NE.0)THEN WRITE(KFILDO,135)(MD(J),J=1,4),(ID(J),J=1,4) 135 FORMAT(' ****PROBABILITIES',2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 1 ' NOT RETRIEVED BY RETVEC IN CNVPOTAK.', 2 ' CANNOT COMPUTE CONVECTION POTENTIAL FOR',/, 3 ' ',2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 4 ' SET POTENTIAL TO MISSING AND CONTINUE') GO TO 400 C ENDIF C 140 DO 160 K=1,NSTA C C ASSIGN THE POTENTIAL (INITIALLY TO N) WHEN THE PROB [XDATA( )] C IS GE TO THE N'TH PROB THRESHOLD [YDATA( )]. C IF(NINT(XDATA(K)).EQ.9997) XDATA(K)=0. C A FORECAST OF 9997 IS TREATED AS 0. IF(NINT(XDATA(K)).EQ.9999) THEN C IF PROB IS MISSING, THE POTENTIAL IS SET TO MISSING. JDATA(K)=9999 ELSEIF(NINT(YDATA(K)).EQ.9999) THEN C IF THRESHOLD IS MISSING, THE POTENTIAL IS SET TO MISSING. JDATA(K)=9999 ELSEIF(XDATA(K).GE.YDATA(K)) THEN C JDATA(K)=N C ENDIF C 160 CONTINUE C 200 CONTINUE C C SET XDATA( ) TO JDATA( ), AND THEN CHANGE TO STANDARD POTENTIAL C CODE VALUES. HOWEVER, THE FORMULATION OF LIGHTNING Y/N CATE- C GORICAL FROM THE CORRESPONDING POTENTIAL REQUIRES A SEPARATE C CODE BRANCH. C C THE FOLLOWING IS FOR THE POTENTIAL SPECIFICATION. DO 210 K=1,NSTA C XDATA(K)=JDATA(K) IF(XDATA(K).EQ.1) THEN XDATA(K)=4 ELSEIF(XDATA(K).EQ.2) THEN XDATA(K)=6 ELSEIF(XDATA(K).EQ.3) THEN XDATA(K)=8 ENDIF C 210 CONTINUE C C WRITE(KFILDO,230) NDATE,ID,(XDATA(KK),KK=1,NSTA,100) C230 FORMAT(' CONVEC POTENTIAL IN CNVPOT, NDATE, MD( ),XDATA( ) = ', C 1 5I10,/,(15F8.3)) C GO TO 450 C C CONVEC POTENTIAL CANNOT BE COMPUTED...SET IT TO MISSING. C 400 DO 410 K=1,NSTA XDATA(K)=9999. 410 CONTINUE C 450 RETURN END