SUBROUTINE MELD_1HCNVPP(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 ID,IDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,SDATA,ND1,NSTA, 3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5, 4 LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH,LASTL,LASTD, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,ISTAB,L3264B,L3264W,IER) C C APRIL 2020 SHAFER CREATED MELD_1HCNVPP FOR MELD 1-H CONV PROBS; C ADAPTED FROM MOS_1HCNVPP C SEPTEMBER 2020 SAMPLATSKY UPDATED PROCESSING ID C C PURPOSE C PERFORM POST-PROCESSING OF REGIONAL MELD 1-H CONVECTION C PROBABILITY FORECASTS VIA THE FOLLOWING STEPS: C (1) REGIONAL WEIGHTING OF DOMAIN-WIDE GRIDDED FORECASTS C FROM REGRESSION EQUATIONS WITH OVERLAPPING REGIONS; C (2) TRUNCATION OF PROBS TO 0.0 - 1.0 RANGE. C C THE FOLLOWING IDPARS(1) AND IDPARS(2) ARE ACCOMMODATED: C 207 760 - POST-PROCESSED 1-HR TL PROB (DD=35/45) 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. C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (INPUT) C KFIL10 = UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM C ACCESS. (INPUT-OUTPUT) 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) = 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). (CHARACTER*60) (INPUT) C NUMRA = THE NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (INPUT) C ID(J) = ID OF VARIABLE BEING PROCESSED (J=1,4). (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C PREDICTAND 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 1 C 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), WHICH IN THIS C CASE IS RELATIVE TO THE MOS CYCLE TIME, C NOT THE LAMP CYCLE TIME. C J=13--I (INTERPOLATION TYPE) C J=14--S (SMOOTHING INDICATOR) C J=15--G (GRID INDICATOR). C JD(J) = THE BASIC VARIABLE IDS (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 THRESH. C JD( ) IS USED TO IDENTIFY THE BASIC MODEL C FIELDS AS READ FROM THE ARCHIVE. (INPUT) C LD(J) = THE VARIABLE ID (J=1,4) USED TO FETCH REGIONAL C WEIGHTS AND THEN PQPFS. (INTERNAL) C LDPARS(J) = AS FOR IDPARS(J) EXCEPT PERTAINING TO LD(J). C (INTERNAL) 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 FOR WHICH VARIABLE IS BEING PRO- C CESSED. (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( , , ) IN C DRU201. (CHARACTER*8; INPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. DIMENSION OF IX( ), IY( ), SDATA ( ), C ISDATA( ), AND FIRST DIMENSION OF CCALL( ,6) C AND PDATA( , ). (INPUT) C ISDATA(K) = WORK ARRAY (K=1,ND1). (INTERNAL) C SDATA(K) = WORK ARRAY AND RETURNED DATA (K=1,ND1). C (INTERNAL/OUTPUT) C ND5 = DIMENSION OF IPACK( ), IWORK( ), DATA( ), C CCALLD( ), FD1( ), FD2( ), AND SECOND DIMENSION C OF ICALLD( , ). (INPUT) C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTE- C GER VARIABLE (L=1,L3264W) (K=1,ND5). THIS ARRAY C IS USED TO READ THE STATION DIRECTORY FROM A C MOS-2000 EXTERNAL FILE. EQUIVALENCED TO C CCALLD( ) IN DRU710. (INTERNAL) C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). THIS ARRAY IS C USED IN CONST TO READ THE STATION DIRECTORY. C EQUIVALENCED TO ICALLD( , ) IN DRU710. C (CHARACTER*8; 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 IDS 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 C NOT. C L=8 --THE DATE/TIME OF THE DATA IN FORMAT C YYYYMMDDHH. C L=9 --NUMBER OF TIMES DATA HAVE BEEN C 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 PREDICTAND IN THE C SORTED LIST IN ID( ,N) (N=1,NPRED) C FOR WHICH THIS VARIABLE IS NEEDED, WHEN C IT IS NEEDED ONLY ONCE FROM C LSTORE( , ). WHEN IT IS NEEDED MORE C THAN ONCE, THE 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( , ) THAT HAVE C BEEN USED IN THIS RUN. (INPUT) C LITEMS = NUMBER OF MOS FORECAST FIELDS HELD IN THE MOS C INTERNAL STORAGE SYSTEM. (INPUT) C ND10 = DIMENSION OF CORE( ). (INPUT) C CORE(J) = THE ARRAY TO STORE OR RETIREVE THE DATA C IDENTIFIED IN LSTORE( , ) (J=1,ND10). WHEN C CORE( ) IS FULL DATA ARE STORED ON DISK. C (OUTPUT) C NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM C DISK FILE. (INPUT) C NFETCH = INCREMENTED EACH TIME RETVEC/GFETCH IS ENTERED. C IT IS A RUNNING COUNT FROM THE BEGINNING OF C THE PROGRAM. THIS COUNT IS MAINTAINED IN C CASE THE USER NEEDS IT (DIAGNOSTICS, ETC.). C NEEDS IT (DIAGNOSTICS, ETC.). (INTERNAL) C LASTL = THE LAST LOCATION IN CORE( ) USED. THIS MAY BE C MODIFIED, ALONG WITH ITEMS, IF COMPACTION IS C DONE BY GCPAC. INITIALIZED TO ZERO ON FIRST C ENTRY TO GSTORE. MUST BE CARRIED WHENEVER C GSTORE IS TO BE CALLED. (INPUT-OUTPUT) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK. C INITIALIZED TO ZERO ON FIRST ENTRY TO GSTORE. C MUST BE CARRIED WHENEVER GSTORE IS TO BE CALLED. C (INPUT-OUTPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 IDS (J=1,3). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 IDS (J=1,22+). C (INTERNAL) C IS2(J) = MOS-2000 GRIB SECTION 2 IDS (J=1,12). C (INTERNAL) C IS4(J) = MOS-2000 GRIB SECTION 4 IDS (J=1,4). C (INTERNAL) C ND7 = DIMENSION OF IS0, IS1, IS2, AND IS4. NOT ALL C LOCATIONS ARE USED. (INPUT) C ISTAV = 1 SINCE THE DATA RETURNED ARE STATION DATA. C 0 WHEN THE DATA RETURNED ARE GRID DATA OR DATA C ARE NOT AVAILABLE FOR RETURN. RETURNED C FROM SOME COMPUTATIONAL ROUTINES THAT CAN C BE USED IN U201. NOT NEEDED IN OPTX, SINCE C ALL DATA ARE STATION ORIENTED. (OUTPUT) C ISTAB = 1 WHEN THE VARIABLE RETURNED IS BINARY; C 0 OTHERWISE. (INTERNAL) 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 47 = GRIDPOINT IDS COULD NOT BE CONVERTED. C 103 = WHEN THE VARIABLE ID IS NOT ACCOMMODATED. C SEE CONST AND RETVEC FOR OTHER VALUES. WHEN C IER NE 0, DATA ARE RETURNED AS MISSING. C (INTERNAL-OUTPUT) C C OTHER VARIABLES C LDPARS(J) = AS FOR IDPARS( ) BUT PERTAINING TO LD( ) C (J=1,15). (INTERNAL) C LD(J) = WORK ARRAY FOR VARIABLE IDS FOR WHICH DATA IS C RETRIEVED FROM INTERNAL OR EXTERNAL STORAGE C (J=1,4). (INTERNAL) C NUMREG = NUMBER OF REGIONS FOR WHICH WEIGHTS AND PQPFS C ARE INGESTED. (PARAMETER) C IDWT(J,K) = HOLDS VARIABLE IDS FOR THE REGIONAL WEIGHTS C (J=1,4) (K=1,NUMREG). (INTERNAL) C WEIGHT(I,K) = HOLDS THE REGIONAL WEIGHTS (I=1,NSTA) C (K=1,NUMREG). (INTERNAL/ALLOCATED) C XDATA(I) = WORK ARRAY (I=1,NSTA). (INTERNAL/AUTOMATIC) C MXTH = MAX NUMBER OF PRECIP THRESHOLDS (OVER 6H AND 12H C VALID PERIODS). (PARAMETER) C PDATA(I,M) = WORK ARRAY USED TO HOLD THE POST-PROCESSED PQPFS C AND THE EXPECTED PRECIP AMOUNT. (I=1,NSTA) C (M=1,MXTH+1). (INTERNAL/ALLOCATED) C NX = NUMBER OF GRID POINTS IN THE X-DIRECTION C ...NEEDED FOR SMOOTHING. (PARAMETER) C NY = NUMBER OF GRID POINTS IN THE Y-DIRECTION C ...NEEDED FOR SMOOTHING. (PARAMETER) C IX(K) = X-COORDINATES OF STATIONS ...NEEDED FOR SMOOTH- C ING (K=1,NSTA). (INTERNAL/ALLOCATED) C IY(K) = Y-COORDINATES OF STATIONS ...NEEDED FOR SMOOTH- C ING (K=1,NSTA). (INTERNAL/ALLOCATED) C FD1(K) = FOR POP CONSISTENCY CHECK HOLDS 6-HR POP FOR C FIRST PART OF 12-H PERIOD (K=1,NSTA). C (INTERNAL/ALLOCATED) C FD2(K) = FOR POP CONSISTENCY CHECK HOLDS 6-HR POP FOR SE- C COND PART OF 12-H PERIOD (K=1,NSTA). C (INTERNAL/ALLOCATED) C GRD1(I,J) = WORK ARRAY USED FOR SMOOTHING (I=1,NX, C J=1,NY). (INTERNAL/AUTOMATIC) C GRD2(I,J) = WORK ARRAY USED FOR SMOOTHING (I=1,NX, C J=1,NY). (INTERNAL/AUTOMATIC) C MVAR = MAX NUMBER OF VARIABLES ACCOMMODATED. C (PARAMETER) C MTH = THE NUMBER OF PRECIP THRESHOLDS FOR THE VARIABLE C BEING PROCESSED. ALSO, THE UPPER BOUND PARAME- C TER IN MANY DO LOOPS. (INTERNAL) C KTH = VARIABLE INDEX IN PDATA( ,KTH). (INTERNAL) C ICCCFFF(K) = VARIABLES ACCOMMODATED (K=1,MVAR). (INTERNAL) C ITH(N) = PRECIP AMOUNT THRESHOLD VALUES ASSOCIATED WITH C ICCCFFF(1) AND ICCCFFF(3) (N=1,MXTH). C (INTERNAL) C IENTRY = SET TO 0 TO GET GRID COORDINATES AND RETRIEVE C CONSTANT DATA ON FIRST ENTRY; SET TO 1 OTHER- C WISE. (INTERNAL) C C NONSYSTEM SUBROUTINES CALLED C RETVEC, SMTH9VW, PRSID1, CONST, XPVAL C PARAMETER (NUMREG=4,MVAR=1,MXTH=1) C CHARACTER*8 CCALL(ND1,6) CHARACTER*8 CCALLD(ND5) CHARACTER*60 RACESS(NUMRA) C INTEGER, ALLOCATABLE, DIMENSION(:) :: IX INTEGER, ALLOCATABLE, DIMENSION(:) :: JY REAL, ALLOCATABLE, DIMENSION (:,:) :: WEIGHT REAL, ALLOCATABLE, DIMENSION (:,:) :: PDATA C DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5),ICALLD(L3264W,ND5) DIMENSION FD1(ND5),FD2(ND5) ! AUTOMATIC ARRAYS C DIMENSION SDATA(ND1),ISDATA(ND1) C DIMENSION IDPARS(15),ID(4),LDPARS(15),LD(4),JD(4),IDWT(4,NUMREG) C DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9),CORE(ND10) C DIMENSION ICCCFFF(MVAR),KFILRA(NUMRA) C C DIMENSION GRD1(NX,NY),GRD2(NX,NY) ! AUTOMATIC ARRAYS C DATA IENTRY/0/ DATA ICCCFFF/207760/ ! 1-H CONV PRB DATA ((IDWT(I,J),I=1,4),J=1,NUMREG) 1 /447999001,0,0,0, ! WEIGHTS FOR REGION 01 2 447999002,0,0,0, ! WEIGHTS FOR REGION 02 3 447999003,0,0,0, ! WEIGHTS FOR REGION 03 4 447999004,0,0,0/ ! WEIGHTS FOR REGION 04 C SAVE IX,JY,IENTRY,WEIGHT,PDATA C MON=MOD(NDATE/10000,100) C C CHECK IF THIS CODE ACCOMMODATES VARIABLE C IF(IDPARS(1).NE.207.OR.IDPARS(2).NE.760) THEN IER=103 WRITE(KFILDO,20) IDPARS(1),IDPARS(2),IER 20 FORMAT(/,' ****IDPARS(1) AND IDPARS(2)= ',2I4, 1 ' NOT ACCOMMODATED IN MELD_1HCNVPP ...SET IER =',I4, 2 ' AND RETURN MISSING VALUES') GO TO 650 ENDIF C MTH=MXTH KTH=MXTH C 30 IF(IENTRY.EQ.0) THEN C C ON FIRST ENTRY, ALLOCATE P( , ), WHICH WILL HOLD THE FINAL C POST-PROCESSED MOS PROBS C ALLOCATE(PDATA(ND1,MXTH),STAT=IOS) C C GET GRID COORDINATES FROM GRIDPOINT IDS AND SAVE THEM IN C ALLOCATED ARRAYS. C ALLOCATE(IX(ND1),STAT=IOS) ALLOCATE(JY(ND1),STAT=IOS) DO 40 K=1,NSTA READ(CCALL(K,1),'(I4.4,4X)',ERR=600) IX(K) READ(CCALL(K,1),'(4X,I4.4)',ERR=600) JY(K) 40 CONTINUE C C FETCH WEIGHTS FOR EACH REGION FROM A VECTOR CONSTANT C FILE. THE WEIGHTS ARE STORED IN AN ALLOCATED ARRAY AND C SAVED SO THEY ARE AVAILABLE FOR SUBSEQUENT CALLS. C ALLOCATE(WEIGHT(ND1,NUMREG),STAT=IOS) C DO 70 NR=1,NUMREG LD(1)=IDWT(1,NR) LD(2)=IDWT(2,NR) LD(3)=IDWT(3,NR) LD(4)=IDWT(4,NR) CALL PRSID1(KFILDO,LD,LDPARS) CALL CONST(KFILDO,KFIL10,IP12, 1 LD,LDPARS,LD,NDATE, 2 KFILRA,RACESS,NUMRA, 3 CCALL,ICALLD,CCALLD, 4 ISDATA,SDATA,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) IF(IER.NE.0)THEN WRITE(KFILDO,50) (LD(J),J=1,4),NDATE,(ID(J),J=1,4) 50 FORMAT(/,' **** IN MELD_1HCNVPP, COULD NOT', 1 ' FETCH CONSTANT DATA FOR ',4I10.9, 2 ' FROM RANDOM ACCESS VECTOR FILE.',/, 3 ' CONTINUE BUT MISSING VALUES WILL BE RETURNED', 4 ' FOR DATE =',I10,' AND ID( ) = ',4I10.9) ENDIF C C COPY CONSTANT DATA INTO WEIGHT( , ) C DO 60 K=1,NSTA WEIGHT(K,NR)=SDATA(K) 60 CONTINUE C 70 CONTINUE C C SET IENTRY TO 1 SO THAT THE ABOVE PROCESSING STEPS ARE PER- C FORMED ONLY ON THE FIRST ENTRY. C IENTRY=1 C ENDIF C C IF ERROR OCCURRED DURING RETRIEVAL OF WEIGHTS, SET PDATA( , ) C TO MISSING VALUES (BELOW). C IF(IER.GT.0) GO TO 195 C C WHEN KTH GT 1, PDATA( , ) ALREADY SET IN A PREVIOUS CALL. C RETRIEVE PROCESSED DATA WANTED FROM THERE. C IF(KTH.GT.1) GO TO 500 C C PERFORM REGIONAL WEIGHTING OF MOS PROBS C IERR=0 C DO 190 M=1,MTH C C FETCH REGIONAL MOS 1H CONV PROB FROM EITHER INTERNAL STORAGE OR C EXTERNAL RA FILE AND MULTIPLY BY CORRESPONDING REGIONAL C WEIGHT. THE SUM OF SUCH PRODUCTS YIELDS THE WEIGHTED DOMAIN C COMPOSITE CONV PROBS (PDATA( , )). FIRST INITIALIZE PDATA( ,M). C DO K=1,NSTA PDATA(K,M)=0.0 ENDDO C DO 180 NR=1,NUMREG IF(IDPARS(4).EQ.35) MDLNUM=NR+30 ! MELD PRIMARY IF(IDPARS(4).EQ.45) MDLNUM=NR+40 ! MELD BACKUP C LD(1)=207750100+MDLNUM LD(2)=ID(2) LD(3)=ID(3) LD(4)=ID(4) C CALL PRSID1(KFILDO,LD,LDPARS) CALL RETVEC(KFILDO,KFIL10,IP12,KFILRA,RACESS,NUMRA, 1 LD,LDPARS,JD,ITAU, 2 NDATE,MDATE,CCALL,ISDATA,SDATA,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 IF(IER.NE.0)THEN WRITE(KFILDO,130) (LD(J),J=1,4),NDATE,(ID(J),J=1,4) 130 FORMAT(' **** IN MELD_1HCNVPP AT LABEL 130, COULD NOT FETCH', 1 ' DATA FOR ',4I10.9,' FOR DATE = ',I10,/, 2 ' ...CONTINUE, BUT MISSING DATA WILL BE RETURNED', 3 ' FOR ID( ) = ',4I10.9) GO TO 180 ENDIF C IERNR=0 NPTS=0 DO 150 K=1,NSTA C IF (WEIGHT(K,NR).GT.0.0.AND.SDATA(K).GT.9998.5) THEN C C UNEXPECTED MISSING PROB FOUND ...SET IERNR AND INCREMENT C COUNTER. C IERNR=104 NPTS=NPTS+1 ELSE C C IF A 9997 IS ENCOUNTERED, SET THE FORECAST TO 0.0 FOR C THE PURPOSE OF WEIGHTING. C IF (SDATA(K).GT.9996.5.AND.SDATA(K).LT.9997.5) SDATA(K)=0.0 PDATA(K,M)=PDATA(K,M)+SDATA(K)*WEIGHT(K,NR) END IF 150 CONTINUE ! k=1,nsta C IF (IERNR.EQ.104) THEN WRITE(KFILDO,160) NDATE,LD,NPTS,NR 160 FORMAT(' **** IN MELD_1HCNVPP AT LABEL 160, DATE, LD( ) = ', 1 1I10,2X, 2 4I10.9,/,' HAS ',I7,' UNEXPECTED MISSING VALUES IN', 3 ' REGION ',I2.2,/,' CONTINUE, BUT THE ENTIRE DATA', 4 ' DOMAIN WILL BE SET TO MISSING.') IERR=IERNR END IF C 180 CONTINUE ! nr=1,numreg 190 CONTINUE ! m=1,mth C C IF AN ERROR OCCURRED DURING ABOVE DATA FETCHES OR IF UNEXPECTED C MISSING PROBS WERE PRESENT FOR ANY REGION OR THRESHOLD, SET C PDATA( , ) TO MISSING AND RETURN THAT TO CALLING ROUTINE. C 195 IF (IER.GT.0.OR.IERR.GT.0) THEN DO 210 M=1,MTH DO 200 K=1,NSTA PDATA(K,M)=9999.0 200 CONTINUE 210 CONTINUE GOTO 500 END IF C C LIMIT THE PROB RANGE TO 0.0 - 1.0 FOR EACH RECORD C DO M=1,MTH DO K=1,NSTA IF(PDATA(K,M).GT.9998.5) THEN PDATA(K,M)=9999. ELSEIF(PDATA(K,M).LT.0.0) THEN PDATA(K,M)=0.0 ELSEIF(PDATA(K,M).GT.1.0) THEN PDATA(K,M)=1.0 ENDIF ENDDO ENDDO C C RETURN THE REQUESTED VARIABLE IN SDATA( ). C 500 DO K=1,NSTA SDATA(K)=PDATA(K,KTH) ENDDO C ISTAV=1 ISTAB=1 GO TO 900 C 600 IER=47 WRITE(KFILDO,610) IER 610 FORMAT(/,'**** IN MELD_1HCNVPP AT LABEL 610, ERROR IN' 1 ' CONVERSION OF', 2 ' FCST PTS...SET IER TO ',I3,' AND RETURN MISSING', 3 ' VALUES.') C 650 DO 660 K=1,NSTA SDATA(K)=9999. 660 CONTINUE C 900 IER=0 RETURN END