SUBROUTINE MOS_1HLTGPP(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 JULY 2019 SHAFER MDL MOS-2000
C JULY 2019 SHAFER CREATED MOS_1HLTGPP FOR MOS 1-H TL PROBS;
C ADAPTED FROM LPQPFPP.
C SEPTEMBER 2020 SAMPLATSKY UPDATED PROCESSING ID
C
C PURPOSE
C PERFORM POST-PROCESSING OF REGIONAL MOS 1-H TOTAL LIGHTNING
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 710 - POST-PROCESSED 1-HR TL PROB
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=2,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/207710/ ! 1-H TOT LTG 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
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.710) THEN
IER=103
WRITE(KFILDO,20) IDPARS(1),IDPARS(2),IER
20 FORMAT(/,' ****IDPARS(1) AND IDPARS(2)= ',2I4,
1 ' NOT ACCOMMODATED IN MOS_1HLTGPP ...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 MOS_1HLTGPP, 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 TOT LTG 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 TOT LTG PROBS (PDATA( , )). FIRST INITIALIZE PDATA( ,M).
C
DO K=1,NSTA
PDATA(K,M)=0.0
ENDDO
C
DO 180 NR=1,NUMREG
C
MDLNUM=NR+10
LD(1)=207700100+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 MOS_1HLTGPP 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
IF(IDPARS(4).EQ.01.OR.IDPARS(4).EQ.03)THEN
C
C FOR ECWMF / RAP ...IF 9999 IS ENCOUNTERED
C SET PDATA=9999 ALSO.
C
PDATA(K,M)=9999.
ELSE
C
C UNEXPECTED MISSING PROB FOUND ...SET IERNR AND INCREMENT
C COUNTER.
C
IERNR=104
NPTS=NPTS+1
END IF
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 MOS_1HLTGPP 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 MOS_1HLTGPP 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