SUBROUTINE BOGUS(KFILDO,IP14,IP25,KFILBO,FLBOGS,ID,IDPARS,JD, 1 CCALL,XP,YP,LNDSEA,XDATA,LTAG,LTAGPT,NSTA, 2 P,NX,NY,MESH,SEALND,NXE,NYE,MESHE,N4P,NAREA, 3 ISTOP,IER) C C FEBRUARY 2008 GLAHN TDL MOS-2000 C REVISED FROM ORIGINAL TO READ FILE C FEBRUARY 2008 GLAHN ADDED IPRINT TO CONTROL SPACING C MARCH 2008 COSGROVE ADDED COMMA TO FORMAT 110, MODIFIED C SPACING OF FORMAT 137 FOR IBM COMP C AUGUST 2008 GLAHN SUBSTITUTED WTOTAL FOR XDATA(K) IN C 252; SUBSTITUTED IP25 FOR IP14 AT 137 C OCTOBER 2008 GLAHN COMMENT ABOUT 60D281-301 BOGUS; C COMMENT ABOUT 70DXXX BOGUS; INCREASED C TEMP(5), WT(5) TO TEMP(10), WT(10); C SPELL CHECK C JULY 2011 GLAHN ADDED LTAGBS( ). C JULY 2011 GLAHN CLOSED KFILBO VICE REWIND C DECEMBER 2011 GLAHN CHANGED DEFINITION OF LTAGBS( ) TO C AGREE WITH OTHER USES; REMOVED ITS C INITIALIZATION; NOW CALLED LTAGPT( ) C SEPTEMBER 2013 GLAHN ADDED LTAG( ) TO CALL; SET = 0 FOR C ADDED BOGUS DATA C FEBRUARY 2014 GLAHN MODIFIED COMMENT ONLY C JUNE 2014 GLAHN SET IER = 777 AFTER IERX C NOVEMBER 2016 GLAHN COMMENT, 70DXXX ALSO USED FOR GMOS C NOVEMBER 2016 GLAHN REPLACED 'LTAGPT(K)=9999' WITH C 'IF(LTAGPT(K).EQ.0)LTAGPT(K)=9999' C IN TWO PLACES C MARCH 2018 GLAHN ACTIVATED /D TO PRINT MISSING DATA; c PRINT AT 254 TO INDICATE MISSING STA C FEBRUARY 2019 GLAHN ADDED DIAGNOSTIC /D 105 C MAY 2019 GLAHN ADDED SMOOTHING BEFORE INTERPOLATION C BASED ON ID(1); ADDED DIMENSIONS C FOR P( , ) AND PSAVE( , ) C MAY 2019 GLAHN CHANGED INC FROM 25 STO 100; EXCLUDED C SMOOTHING OVER WATER AND SIBERIA; C ADDED SMOOTHING FOR LAMP PROBS C MAY 2019 GLAHN DELETED IPRINT=1 IS SEVERAL PLACES C JUNE 2019 GLAHH SET IFIRST = 0 C JUNE 2019 GLAHN PUT 'COUNT AS AN ISTOP(6) ERROR' IN C DIAGNOSTICS; 2535 MODIFIED C C PURPOSE C TO INTERPOLATE INTO THE FIRST GUESS TO GET POINTS TO C ANALYZE. THIS IS NECESSARY IN THE VICINITY OF ALASKA C IN THE BERING SEA WHERE THERE ARE NO BUOYS AND THE FIRST C GUESS IS NOT RESPECTFUL OF THE LAND/WATER BOUNDARY. C THESE INTERPOLATED POINTS, FAR ENOUGH OUT IN THE WATER C TO BE USEFUL, ARE THEN USED TO BRING THE SAME VALUES C INTO THE NEAR THE COAST. C C ALSO TO CALCULATE A SET OF BOGUS VALUES AS WEIGHTED C AVERAGES OF OTHER DATA POINTS FOR U155. C 60D001-024 ARE IN GULF OF ALASKA AND ARE COMBINATIONS OF C GULF BUOYS AND MIDDLETON ISLAND (USED AS WATER); C 60D281-301 ARE IN THE ARCTIC OCEAN; C 69D025-045 ARE IN MAINLAND ALASKA AND ARE COMBINATIONS OF C LAND STATIONS; C 69D088-125 ARE LAND NEAR ARCTIC OCEAN AND ARE COMBINATIONS C OF OTHER NEAR-OCEAN STATIONS. C 61D046-073 ARE IN THE BERING SEA AND ARE EITHER C INTERPOLATED FROM THE FIRST GUESS OR ARE C COMBINATIONS OF THOSE INTERPOLATED VALUES. C 70DXXX ARE BEING USED AROUND THE CONUS IN HOURLY C ANALYSIS AND GMOS. C BOGUSXX ARE BEING USED FOR LAMP CIG/VIS C C TWO LISTS ARE READ IN, EACH ENDING WITH A TERMINATOR C '99999999'. THE STATIONS IN THE FIRST ARE FOR C INTERPOLATION, THE SECOND IS FOR AVERAGING. A MAXIMUM C OF 10 STATIONS AND WEIGHTS CAN BE READ FOR EACH STATION C FOR AVERAGING THE NAME OF THE FILE TO READ IS READ C IN U405A.CN IN ASSOCIATION WITH THE PREPROCESSOR BOGUS. C C BOGUS IS CALLED FOR EACH RUN (WITH RUN AVERAGING). THE C INTERPOLATION IN EACH CALL WILL BE THE SAME (DUPLICATE C ITSELF), BUT THE AVERAGING WILL GIVE DIFFERENT RESULTS. C C THE BOGUS 'CALL LETTERS' WILL BE OF THE FORM 6YDXXX OR C 7YD, WHERE C 6YD = THE KEY THIS IS BOGUS FOR ALASKA, C 7YD = THE KEY THIS IS BOGUS FOR CONUS, C Y = AN IDENTIFIER SPECIFIC TO VARIABLE AND AREA (E.G. C GULF OF ALASKA) AS NEEDED, AND C XXX = A SEQUENTIAL NUMBER, WHICH CAN BE SPECIFIC TO C VALUES OF Y. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C IP14 - UNIT NUMBER FOR PROBLEMS IN ITRPSL. (OUTPUT) C IP25 - UNIT NUMBER FOR PROBLEMS WITH BOGUS STATIONS. C (OUTPUT) C KFILBO - UNIT NUMBER FOR READING BOGUS STATIONS AND C WEIGHTS. (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C IP14 = UNIT NUMBER FOR PROBLEMS IN ITRPSL. (INPUT) C IP25 = UNIT NUMBER FOR PROBLEMS WITH BOGUS STATIONS. C (INPUT) C KFILBO = UNIT NUMBER FOR READING BOGUS STATIONS AND C WEIGHTS. (INPUT) C FLBOGS = FILE NAME CORRESPONDING TO KFILBO. C (CHARACTER*60) (INPUT) C ID(J) = 4-WORD ID OF VARIABLE TO PROVIDE DATA FOR C (J=1,4). (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE ID'S CORRESPONDING TO ID( ) C (J=1,15), (N=1,ND4). C J=1--CCC (CLASS OF VARIABLE), C J=2--FFF (SUBCLASS OF VARIABLE), 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), EXCEPT THAT THE C PORTIONS PERTAINING TO PROCESSING ARE OMITTED. C NOT ACTUALLY USED. (INPUT) C CCALL(K) = CALL LETTERS OF STATIONS (J=1,NSTA). C (INPUT) 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 LNDSEA(K) = LAND/SEA INFLUENCE FLAG FOR EACH STATION C (K=1,ND1). C 0 = WILL BE USED FOR ONLY OCEAN WATER (=0) C GRIDPOINTS. C 3 = WILL BE USED FOR ONLY INLAND WATER (=3) C GRIDPOINTS. C 6 = WILL BE USED FOR BOTH INLAND WATER (=3) C AND LAND (=9) GRIDPOINTS. C 9 = WILL BE USED FOR ONLY LAND (=9) GRIDPOINTS. C (INPUT) C XDATA(K) = DATA VALUES (K=1,NSTA). (INPUT/OUTPUT) C LTAG(J) = DENOTES USE OF DATA CORRESPONDING TO CCALL(J). C +4 = TOSSED IN A PREVIOUS OBS RUN AND C MAINTAINED DOWNSTREAM. C +3 = TOSSED IN A PREVIOUS LAMP RUN, AND C MAINTAINED DOWNSTREAM. C +2 = NOT USED FOR ANY PURPOSE. C +1 = PERMANENTLY DISCARDED FOR THE VARIABLE C BEING ANALYZED. INCLUDES DATA FAR C OUTSIDE THE GRID, AS DEFINED BY RMAX C 0 = USE ON CURRENT PASS THROUGH DATA. C -1 = DO NOT USE ON THIS PASS. C -3 = ACCEPT THIS STATION ON EVERY PASS. THIS C FEATURE MAY OR MAY NOT BE IMPLEMENTED IN C THE CALLING PROGRAM. (INPUT/OUTPUT) C LTAGPT(K) = FOR STATION K (K=1NSTA), C 1 = AUGMENTED DATA (FIRST PASS) C 2 = AUGMENTED DATA (2ND OR LATER PASS) C 3 = BOGUS DATA C 0 = EVERYTHING ELSE C (INPUT) C NSTA = NUMBER OF STATIONS BEING USED; THE NUMBER C OF VALUES IN CCALL( ) AND XDATA( ). (INPUT) C P(IS,JY) = THE FIRST GUESS FROM FSTGS5 (IX=1,NX) C (JY=1,NY). (INPUT) C NX = THE X-EXTENT OF THE GRID P( , ). (INPUT) C NY = THE Y-EXTENT OF THE GRID P( , ). (INPUT) C MESH = THE NOMINAL MESH LENGTH OF THE GRID BEING DEALT C WITH WHOSE DIMENSIONS ARE NX AND NY, AND C THE STATION LOCATIONS IN XP( ) AND YP( ) ARE C IN REFERENCE TO. (INPUT) C SEALND(J) = THE LAND/SEA MASK (J=1,NXE*NYE). C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C (INPUT) C NXE = X-EXTENT OF SEALND( ) AT MESH LENGTH MESHE. C (INPUT) C NYE = Y-EXTENT OF SEALND( ) AT MESH LENGTH MESHE. C (INPUT) C MESHE = THE NOMINAL MESH LENGTH OF THE SEALND GRID C OF SIZE NXE BY NYE. (INPUT) C N4P = 4 INDICATES THE SURROUNDING 4 POINTS WILL BE C CHECKED WHEN TRYING TO FIND A GRIDPOINT OF C THE SAME TYPE AS THE DATUM AND INTERPOLATION C CAN'T BE DONE. CURRENTLY, THIS IS ALWAYS C DONE (DOES NOT REQUIRE N4P=4). C 12 SAME AS ABOVE, EXCEPT 12 ADDITIONAL POINTS C WILL BE CHECKED WHEN NONE OF THE 4 POINTS C ARE OF THE CORRECT TYPE. C N4P IS OPERATIVE ONLY WHEN THE DATUM AND C THE SURROUNDING 4 POINTS ARE OF MIXED TYPE. C (INPUT) C NAREA = THE AREA OVER WHICH THE ANALYSIS IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, C 4 = PUERTO. C (INPUT) C ISTOP(J) = ISTOP(1)--IS INCREMENTED BY 1 EACH TIME A FATAL C ERROR OCCURS. C ISTOP(5)--IS INCREMENTED IN ITRPSL WHEN NO C NON-MISSING GRIDPOINT AROUND THE C DATA POINT IS OF THE SAME TYPE. C ISTOP(6)--IS INCREMENTED WHEN THERE IS A PROBLEM C WITH MAKING BOGUS STATIONS. C (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 TEMPST = BOGUS STATION, READ FROM FILE. (CHARACTER*8) C (INTERNAL) C TEMP(J) = TEMPORARY ARRAY INTO WHICH TO READ THE STATION C IDENTIFIERS USED IN AVERAGING (J=1,10), SOME OF C WHICH CAN BE BLANK. (CHARACTER*8) C (INTERNAL) C WT(J) = TEMPORARY ARRAY INTO WHICH TO READ THE WEIGHTS C FOR THE STATIONS IN TEMP(J) TO BE USED FOR THE C AVERAGING (J=1,10). (INTERNAL) C LTEMP(J) = 1 INDICATES STATION IN LIST HAS BEEN FOUND; C 0 OTHERWISE (J=1,10). USED FOR DIAGNOSTICS. C (INTERNAL) C PSAVE(IX,JY) = SAVES P( , ) SO IT CAN BE RESTORED ON EXIT C (IX=1,NX) (JY=1,NY). (INTERNAL) (AUTOMATIC) C 1 2 3 4 5 6 7 X C CHARACTER*6 STATE CHARACTER*8 CCALL(NSTA),TEMPST,TEMP(10) CHARACTER*60 FLBOGS C DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION XP(NSTA),YP(NSTA),LNDSEA(NSTA),XDATA(NSTA),LTAGPT(NSTA), 1 LTAG(NSTA) DIMENSION P(NX,NY) DIMENSION SEALND(NXE,NYE) DIMENSION PSAVE(NX,NY) C PSAVE( , ) IS AN AUTOMATIC ARRAY. DIMENSION WT(10) DIMENSION ISTOP(6),LTEMP(10) C IER=0 CALL TIMPR(KFILDO,KFILDO,'START BOGUS ') IPRINT=1 C C IF MANY POINTS ARE INTERPOLATED, RAP NEEDS TO BE SMOOTHED. C IN THAT CASE, SET IFIRST = 1. C CURRENTLLY FOR CIG AND VIS, ONLY THREE POINTS IN THE ARCTIC C ARE INTERPOLATED, SO SMOOTHING IS NOT WORTH THE CP TIME. C FOR NO SMOOTHING, SET IFIRST = 0 C IFIRST=0 C D WRITE(KFILDO,100)KFILDO,IP14,ID,NXE,NYE,MESH,MESHE,N4P D100 FORMAT(/,' AT 100 IN BOGUS--KFILDO,IP14,ID,,NXE,NYE,MESH,', D 1 'MESHE,N4P',/,11I10) C C OPEN FILE AND READ CONTROL INFORMATION. C STATE='120 ' OPEN(UNIT=KFILBO,FILE=FLBOGS,STATUS='OLD', 1 IOSTAT=IOS,ERR=900) WRITE(KFILDO,110)KFILBO,FLBOGS 110 FORMAT(/,' OPENING OLD FILE ON UNIT NO.',I3,' FILE = ',A60) C C READ THE LIST THAT REQUIRES INTERPOLATION INTO A C FIRST GUESS FIELD. C STATE='125 ' 125 READ(KFILBO,130,IOSTAT=IOS,ERR=900)TEMPST C TEMPST IS A STATION IDENTIFIER THAT MUST BE IN THE C DICTIONARY FOR IT TO BE USED. THERE IT GETS THE LOCATION. 130 FORMAT(A8) C IF(TEMPST.EQ.'99999999')GO TO 200 C THIS IS THE TERMINATOR FOR THE INTERPOLATION LIST. C C ONCE IT IS ESTABLISHED THERE IS AT LEAST ONE BOGUS POINT C FOR INTERPOLATION, SAVE P( , ) IN PSAVE( , ), AND SMOOTH C P( , ). THIS WILL BE DONE ONLY ONCE, BASED ON IFIRST, C NAREA, AND ID( ). C IF(IFIRST.EQ.1)THEN C IF(NAREA.EQ.2.AND. 1 (ID(1).EQ.728000085.OR.ID(1).EQ.728100085.OR. 2 ID(1).EQ.228130205.OR.ID(1).EQ.228060205))THEN C THE VARIABLES ARE CIG AND VIS, PROBS AND CATEGORICAL. C WRITE(KFILDO,1305)(ID(JJ),JJ=1,4) 1305 FORMAT(/' SMOOTHING MODEL BEFORE INTERPOLATION IN BOGUS', 1 ' FOR VARIABLE ',3I10.9,I10) C IFIRST=IFIRST+1 INC=50 CALL TRNSFR(P,PSAVE,NX*NY) C DO 134 JY=1,NY DO 133 IX=1,NX C C*********************************************** C INSERTED 5/21/19 TO ELIMINATE SMOOTHING OVER OCEAN C AND SIBERIA FOR ALASKA AREA. MATCHES AREA IN BOGUS2. C IF(SEALND(IX,JY).EQ.0.OR. 1 (IX.LT.610.AND.JY.GT.756))THEN gO TO 133 ENDIF C********************************************** C P(IX,JY)=0. ICOUNT=0 ISX=MAX(IX-INC,1) IEX=MIN(IX+INC,NX) JSY=MAX(JY-INC,1) JEY=MIN(JY+INC,NY) C DO 132 JYY=JSY,JEY DO 131 IXX=ISX,IEX C IF(PSAVE(IXX,JYY).LT.9998.5)THEN P(IX,JY)=P(IX,JY)+PSAVE(IXX,JYY) ICOUNT=ICOUNT+1 ENDIF C 131 CONTINUE 132 CONTINUE C IF(ICOUNT.NE.0)THEN P(IX,JY)=P(IX,JY)/ICOUNT ELSE P(IX,JY)=PSAVE(IX,JY) C THIS WILL BE MISSING (9999.). ENDIF C 133 CONTINUE 134 CONTINUE C ENDIF C ENDIF C C FIND THE STATION TEMPST IN THE LIST. NOTE THAT THE STATION C LIST MUST CONTAIN IT AS WELL AS THE DICTIONARY. LIKELY C THIS LIST WILL BE SHORT, SO SEARCH THE ENTIRE STATION LIST C UNTIL IT IS FOUND. ALSO, THE BOGUS LIST IS LIKELY NOT IN C ORDER. C DO 140 K=1,NSTA C IF(TEMPST.EQ.CCALL(K))THEN C THIS IS A STATION FOR INTERPOLATION. CALL ITRPSL(KFILDO,IP14,P,NX,NY, 1 CCALL(K),XP(K),YP(K),LNDSEA(K), 2 SEALND,NXE,NYE, 3 MESH,MESHE,N4P,BB,ISTOP,IER) C VALUE INTERPOLATED FROM CURRENT ANALYSIS IS NOW IN BB. C INTERPOLATION INTO FIRST GUESS FROM HERE SHOULD NOT C GIVE A MISSING VALUE. BUT CHECK FOR GOOD RETURN. C D WRITE(KFILDO,135)K,CCALL(K),XP(K),YP(K),BB,IER D135 FORMAT(/,' AT 135 IN BOGUS--K,CCALL(K),XP(K),YP(K),BB,IER', D 1 I5,2X,A8,3F10.2,I5) C IF(IER.NE.0)THEN XDATA(K)=9999. C THIS IS A PRECAUTION. XDATA(K) SHOULD COME IN AS C 9999. IF(LTAGPT(K).EQ.0)LTAGPT(K)=9999 C BOGUS IS ENTERED FOR EACH RUN. THE BOGUS VALUE C MAY BE THERE FOR ONLY ONE RUN. DO NOT OBLITERATE C A PREVIOUSLY SET VALUE. C IF(IER.EQ.196)THEN WRITE(KFILDO,137)CCALL(K) C IF(IP25.NE.0)THEN WRITE(IP25,137)CCALL(K) 137 FORMAT(/,' ERROR IN ITRPSL IN BOGUS COMPUTING ', 1 'POINT ',A8,'. NOT ALL POINTS ARE GIVEN', 2 ' NON-MISSING VALUES.') C THIS FOLLOWS A DIAGNOSTIC IN ITRPSL. ISTOP( ) HAS C BEEN INCREMENTED. ENDIF C ELSEIF(IER.EQ.195)THEN WRITE(KFILDO,137)CCALL(K) ENDIF C GO TO 125 ELSE XDATA(K)=BB C VIS OBS WERE SET TO MAX OF 12 BEFORE SMOOTHING IN C FSTGS5. LTAGPT(K)=3 LTAG(K)=0 GO TO 125 ENDIF C ENDIF C 140 CONTINUE C C DROP THROUGH HERE MEANS THE BOGUS STATION READ INTO TEMPST C IS NOT IN THE DIRECTORY. C WRITE(KFILDO,145)TEMPST 145 FORMAT(' ****COULD NOT FIND BOGUS STATION ',A8, 1 ' IN STATION LIST. THEREFORE, IT IS NOT USED.', 2 ' COUNT AS AN ISTOP(6) ERROR.') ISTOP(6)=ISTOP(6)+1 IPTINT=1 C GO TO 125 C C IF SMOOTHING WAS DONE, RESTORE P( , ). C 200 IF(IFIRST.GT.1)THEN CALL TRNSFR(PSAVE,P,NX*NY) ENDIF C C READ THE LIST THAT THAT DOES NOT REQUIRE INTERPOLATION C INTO A FIRST GUESS FIELD, BUT RATHER THE STATION VALUE C WILL BE A WEIGHTED AVERAGE OF OTHER STATIONS, SOME OF C WHICH COULD BE THE ONES INTERPOLATED ABOVE. C NSTART=1 NEND=NSTA C 201 STATE='200 ' READ(KFILBO,230,IOSTAT=IOS,ERR=900)TEMPST,(TEMP(J),J=1,10) C TEMPST IS A STATION IDENTIFIER THAT MUST BE IN THE C DICTIONARY FOR IT TO BE USED. THERE IT GETS THE LOCATION. C TEMP(J) HOLDS THE STATION IDENTIFIERS FOR AVERAGING. 230 FORMAT(11A8) C IF(TEMPST.EQ.'99999999')GO TO 300 C THIS IS THE TERMINATOR FOR THE AVERAGE LIST. C C READ THE WEIGHTS. C STATE='231 ' READ(KFILBO,231,IOSTAT=IOS,ERR=900)(WT(J),J=1,10) C FIND THE STATION TEMPST IN THE LIST. NOTE THAT THE C STATION LIST MUST CONTAIN IT AS WELL AS THE DICTIONARY. 231 FORMAT(8X,10F8.2) c D WRITE(KFILDO,232)TEMPST,(TEMP(J),WT(J),J=1,10) D232 FORMAT(/' AT 232--TEMPST,(TEMP(J),WT(J),J=1,10)',/, D 1 6X,A8,10(2X,A8,F8.2)) C 233 DO 260 K=NSTART,NEND C IF(TEMPST.EQ.CCALL(K))THEN C THIS IS A STATION TO OBTAIN FROM OTHERS BY WEIGHTED C AVERAGING. C XDATA(K)=0. WTOTAL=0. C ISTART=1 IEND=NSTA C DO 250 L=1,10 LTEMP(L)=0 C IF(TEMP(L).EQ.' ')GO TO 252 C THE FIRST BLANK IN THE LIST THROWS IT OUT OF THE LOOP. C 235 DO 240 N=ISTART,IEND C CCCC IF(TEMPST.EQ.'CBOGUS2 ')THEN CCCC WRITE(KFILDO,236)N,ISTART,IEND,L,TEMP(L),CCALL(N), CCCC 1 XDATA(N) CCCC 236 FORMAT(' AT 236--N,ISTART,IEND,L,TEMP(L),CCALL(N)', CCCC 1 'XDATA(N)',4I5,2(2X,A8),F10.2) CCCC ENDIF C IF(TEMP(L).EQ.CCALL(N))THEN C THERE IS A MATCH. C IF(XDATA(N).LT.9998.5)THEN WTOTAL=WTOTAL+WT(L) XDATA(K)=XDATA(K)+XDATA(N)*WT(L) LTEMP(L)=1 C LTEMP(L) INDICATES STATION L IN TEH AVERAGING LIST C HAS BEEN FOUND. C D IF(TEMPST.EQ.'CBOGUS2 ')THEN D WRITE(KFILDO,237)TEMPST,TEMP(L),WT(L),XDATA(N), D 1 XDATA(K) D237 FORMAT(/' IN BOGUS--TEMPST,TEMP(L),WT(L),XDATA(N),', D 1 'XDATA(K) ',2A8,3F10.3) D ENDIF C ELSE C IF(IPRINT.EQ.1)THEN WRITE(KFILDO,238) 238 FORMAT(' ') IPRINT=0 ENDIF C D WRITE(KFILDO,239)TEMP(L),TEMPST D239 FORMAT(' MISSING DATA FOR BOGUS STATION ',A8, D 1 ' AVERAGING FOR STATION ',A8) ENDIF C ISTART=MIN(N+1,NSTA) C START THE NEXT SEARCH AFTER THE ONE FOUND. IEND=NSTA GO TO 250 C ENDIF C 240 CONTINUE C C DROP THROUGH HERE MEANS MATCH HAS NOT BEEN FOUND. C MAKE SURE THE FULL LIST HAS BEEN SEARCHED. C IF(ISTART.NE.1)THEN IEND=ISTART-1 ISTART=1 GO TO 235 ELSE WRITE(KFILDO,245)TEMP(L),TEMPST 245 FORMAT(' ****COULD NOT FIND STATION ',A8,' IN BOGUS', 1 ' STATION AVERAGE LIST. AVERAGE ',A8, 2 ' WITHOUT IT. COUNT AS AN ISTOP(6) ERROR.') ISTOP(6)=ISTOP(6)+1 IEND=NSTA C WHEN A STATION IS NOT FOUND, SEARCH THE COMPLETE C LIST FOR THE NEXT STATION. ENDIF C 250 CONTINUE C C DIVIDE BY AVERAGE IN CASE NOT ALL VALUES WERE FOUND. C 252 IF(WTOTAL.NE.0.)THEN XDATA(K)=XDATA(K)/WTOTAL LTAGPT(K)=3 C LTAGPT( ) = 3 INDICATES A BOGUS VALUE. LTAG(K)=0 C LTAG( ) = 0 INDICATES A VALUE TO USE. C DO 254 L=1,10 C IF(TEMP(L).NE.' ')THEN C IF(LTEMP(L).EQ.0)THEN WRITE(KFILDO,2535)TEMP(L),TEMPST 2535 FORMAT(' ****MISSING DATA FOR STATION ',A8, 1 ' FOR BOGUS STATION ',A8) ENDIF C ENDIF C 254 CONTINUE C ELSE WRITE(KFILDO,255)TEMPST 255 FORMAT(' ****COULD NOT FIND ANY DATA FOR STATIONS IN', 1 ' BOGUS STATION LIST. SET BOGUS STATION ',A8, 2 ' TO MISSING. COUNT AS AN ISTOP(6) ERROR.') XDATA(K)=9999. IF(LTAGPT(K).EQ.0)LTAGPT(K)=9999 ISTOP(6)=ISTOP(6)+1 ENDIF C NSTART=MIN(K+1,NSTA) C START THE NEXT SEARCH AFTER THE ONE FOUND. NEND=NSTA GO TO 201 C THIS STATION TEMPST HAS BEEN PROCESSED. READ ANOTHER ONE. C ENDIF C 260 CONTINUE C C DROP THROUGH HERE MEANS BOGUS STATION COULD NOT BE C FOUND IN STATION LIST. MAKE SURE COMPLETE LIST HAS C BEEN SEARCHED. C IF(NSTART.NE.1)THEN NEND=NSTART-1 NSTART=1 GO TO 233 ELSE NEND=NSTA ENDIF C WRITE(KFILDO,265)TEMPST 265 FORMAT(' ****COULD NOT FIND BOGUS STATION ',A8, 1 ' IN STATION LIST. THEREFORE, IT IS NOT USED.') ISTOP(6)=ISTOP(6)+1 GO TO 201 C 300 CONTINUE C CCCC WRITE(KFILDO,325)(K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),K=1,NSTA) CCCC 325 FORMAT(/,' IN BOGUS AT 325--(K,CCALL(K),XDATA(K),LTAG(,K),', CCCC 1 'LTAGPT(K)',/,4(I14,1X,A8,1X,F8.2,2I4)) C 350 CLOSE(UNIT=KFILBO) C KFILBO IS CLOSED IN CASE THE UNIT NUMBER IS USED SOMEWHERE C ELSE (E.G., IN ENHANC) AND THERE IS A CONFLICT. C CALL TIMPR(KFILDO,KFILDO,'END BOGUS ') RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'BOGUS ',STATE) WRITE(KFILDO,901) 901 FORMAT(' ABORTING BOGUS. COUNT AS AN ISTOP(6) ERROR.') ISTOP(6)=ISTOP(6)+1 IER=777 GO TO 350 END