SUBROUTINE ENHANC(KFILDO,IP14,KFIL10,KFILEN,FLENHC, 1 NDATE,ID,IDPARS,JD, 2 CCALL,LTAG,XP,YP,LNDSEA,XDATA,NSTA, 4 LSTORE,ND9,LITEMS, 5 IS0,IS1,IS2,IS4,ND7, 6 IPACK,IWORK,DATA,ND5, 7 CORE,ND10,NBLOCK,NFETCH, 8 L3264B,ISTOP,IER) C C JULY 2011 GLAHN TDL MOS-2000 C REVISED FROM BOGUS C JUNE 2014 GLAHN PULLED IER=0 OUT BELOW GFETCH; SET C IER = 777 AFTER IERX C AUGUST 2014 GHIRARDELLI MDL MODIFIED OPEN STATEMENT FOR OPERATIONS C C PURPOSE C TO ADD AN INCREMENT TO EACH STATION INDICATED BY THE C WEIGHTED AVERAGE DIFFERENCE BETWEEN WIND SPEED AND GUSTS C AT AN ASSOCIATED SET OF STATIONS. THE STATIONS TO C AUGMENT WOULD NORMALLY BE BOGUS STATIONS. C 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. C C A MAXIMUM OF 10 STATIONS AND WEIGHTS CAN BE READ FOR EACH C STATION FOR AVERAGING. THE NAME OF THE FILE TO READ IS READ C IN U405A.CN IN ASSOCIATION WITH THE PREPROCESSOR ENHANC. C C THE 'CALL LETTERS' WILL NORMALLY 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 KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C KFILEN - UNIT NUMBER FOR READING ENHANC 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 KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C KFILEN = UNIT NUMBER FOR READING ENHANC STATIONS AND C WEIGHTS. (INPUT) C FLENHC = FILE NAME CORRESPONDING TO KFILEN. C (CHARACTER*60) (INPUT) C NDATE = DATE/TIME, YYYYMMDDHH. THIS IS THE ANALYSIS C RUN TIME, INCLUDING HH. (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( ,N) 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,N), 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 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 = STATION LOCATION UNKNOWN. NOT USED FOR ANY C PURPOSE. C +1 = STATION OUTSIDE RADIUS OF INFLUENCE FOR C AREA BEING ANALYZED OR MISSING DATUM. C PERMANENTLY DISCARDED. C 0 = USE ON CURRENT PASS THROUGH DATA IN BCD. C -1 = ON RETURN FROM BCD, THE DATUM WAS NOT C USED ON THE LAST PASS. C -3 = ACCEPT THIS STATION ON EVERY PASS IN BCD. C (NOT IMPLEMENTED IN U405A) 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 NSTA = NUMBER OF STATIONS BEING USED; THE NUMBER C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). 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 TDLPACK, 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 FIRST VARIABLE IN THE C LIST IN ID( ,N) (N=1,NPRED) FOR C WHICH THIS VARIABLE IS NEEDED, WHEN IT C DOES NOT NEED TO BE STORED AFTER DAY 1. C WHEN THE VARIABLE MUST BE STORED (TO BE C ACCESSED THROUGH OPTION) FOR ALL DAYS, C ID(11,N) IS 7777 + THE NUMBER OF THE C FIRST VARIABLE IN THE LIST FOR WHICH C THIS VARIABLE IS NEEDED. C L=12 --USED INITIALLY IN ESTABLISHING C MSTORE( , ). LATER USED AS A WAY OF C DETERMINING WHETHER TO KEEP THIS VARIABLE. C (INPUT) C LITEMS = THE NUMBER OF ITEMS IN LSTORE( , ). (INPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ). C SECOND DIMENSION OF LSTORE( , ). (INPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). 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 C IS4( ). (INPUT) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ). C (INPUT) C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT C FIELDS (J=1,ND10). WHEN THIS SPACE IS C EXHAUSTED, SCRATCH DISK WILL BE USED. THIS C IS THE SPACE USED FOR THE MOS-2000 INTERNAL C RANDOM ACCESS SYSTEM. (INPUT) C ND10 = THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF C DATA CORE( ). WHEN THIS SPACE IS EXHAUSTED, C SCRATCH DISK WILL BE USED. (INPUT) C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. (INPUT) C NFETCH = NUMBER OF TIMES A RECORD HAS BEEN FETCHED FROM C INTERNAL STORAGE. (INPUT/OUTPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). 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 C IS4( ). (INPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT). C ISTOP(J) = ISTOP(1)--IS INCREMENTED BY 1 EACH TIME A FATAL C ERROR OCCURS. C ISTOP(6)--IS INCREMENTED WHEN THERE IS A PROBLEM C WITH ENHANCING STATIONS. C (INPUT/OUTPUT) C IER = ERROR CODE. C 0 = GOOD RETURN. C 777 = READING ERROR C ALSO ON ERROR FROM GFETCH C (OUTPUT) C TEMPST = ENHANC 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 1 2 3 4 5 6 7 X C CHARACTER*6 STATE CHARACTER*8 CCALL(NSTA),TEMPST,TEMP(10) CHARACTER*60 FLENHC C DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION XP(NSTA),YP(NSTA),LNDSEA(NSTA),XDATA(NSTA),LTAG(NSTA) DIMENSION IPACK(ND5),DATA(ND5),IWORK(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION WT(10) DIMENSION ISTOP(6),LD(4) C IER=0 CALL TIMPR(KFILDO,KFILDO,'START ENHANC ') IPRINT=1 C D WRITE(KFILDO,100)KFILDO,IP14,ID D100 FORMAT(/,' AT 100 IN ENHANC--KFILDO,IP14,ID',3I10) C C OPEN FILE AND READ CONTROL INFORMATION. C STATE='120 ' COPS OPEN(UNIT=KFILEN,FILE=FLENHC,STATUS='OLD', COPS 1 IOSTAT=IOS,ERR=900) OPEN(UNIT=KFILEN,STATUS='OLD',IOSTAT=IOS,ERR=900) WRITE(KFILDO,110)KFILEN,FLENHC 110 FORMAT(/,' OPENING OLD FILE ON UNIT NO.',I3,' FILE = ',A60) C C GET THE WIND SPEED OBS. 224335000 C LD(1)=204335000+IDPARS(4) C THIS IS THE ID OF THE WIND SPEEDS OBS WITH DD ADDED. LD(2)=ID(2) LD(3)=ID(3) LD(4)=ID(4) ITIME=0 CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,ND5, 2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSOURC,MISSP,MISSS,L3264B,ITIME, 4 IER) C IF(IER.NE.0)THEN WRITE(KFILDO,130)(LD(J),J=1,4) 130 FORMAT(/,' ****WIND SPEED NOT RETRIEVED BY GFETCH IN ENHANC', 1 2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3,/ 2 ' GUST SPEED CANNOT BE ENHANCED OVER THE OCEAN.') ISTOP(1)=ISTOP(1)+1 C ERROR IS NOT COUNTED AS FATAL IN U405A. GO TO 350 ENDIF C IF(NWORDS.NE.NSTA)THEN WRITE(KFILDO,131)NWORDS,NSTA 131 FORMAT(/,' ****NWORDS =',I6,' RETURNED FROM GFETCH', 1 ' NOT EQUAL TO NSTA =',I6,' IN ENHANC.'/ 2 ' WIND SPEED OVER OCEAN CANNOT BE ENHANCED.') ISTOP(1)=ISTOP(1)+1 GO TO 350 ENDIF C C READ THE LIST OF STATIONS TO BE ENHANCED. C 200 NSTART=1 NEND=NSTA C 201 STATE='200 ' READ(KFILEN,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 COMPUTING C THE DIFFERENCES FOR ENHANCING. 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='232 ' READ(KFILEN,232,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. 232 FORMAT(8X,10F8.2) C 233 DO 260 K=NSTART,NEND C CCCC WRITE(KFILDO,2335)K,NSTART,NEND,TEMPST,CCALL(K) CCCC 2335 FORMAT(' AT 2335--K,NSTART,NEND,TEMPST,CCALL(K)', CCCC 1 3I5,2(2X,A8)) C D WRITE(KFILDO,234)TEMPST,CCALL(K),(TEMP(J),WT(J),J=1,10) D234 FORMAT(/' AT 334--TEMPST,CCALL(K),(TEMP(J),WT(J),J=1,10)',/, D 1 6X,2A8,10(2X,A8,F8.2)) C IF(TEMPST.EQ.CCALL(K))THEN C THIS IS A STATION TO AUGMENT FROM OTHERS BY A WEIGHTED C DIFFERENCE. C SUM=0. WTOTAL=0. C ISTART=1 IEND=NSTA C DO 250 L=1,10 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.'61D053 ')THEN CCCC WRITE(KFILDO,237)N,CCALL(N),XDATA(N),ISTART,IEND, CCCC 1 L,TEMP(L) CCCC 237 FORMAT(' AT 237--N,CCALL(N),XDATA(N),ISTART,IEND,', CCCC 1 'L,TEMP(L)',I5,2X,A8,F8.2,3I8,2X,A8) CCCC ENDIF C IF(TEMP(L).EQ.CCALL(N))THEN C THERE IS A MATCH. C IF(XDATA(N).LT.9998.5.AND.DATA(N).LT.9998.5.AND. 1 LTAG(N).EQ.0)THEN C WHEN LTAG(N) NE 0, THE STATION WAS DEEMED NOT C USABLE. WTOTAL=WTOTAL+WT(L) SUM=SUM+(XDATA(N)-DATA(N))*WT(L) CCCC WRITE(KFILDO,2375)K,CCALL(K),L,N,TEMP(L),CCALL(N), CCCC 1 XDATA(K),XDATA(N),DATA(N),WT(L),WTOTAL,SUM CCCC 2375 FORMAT(' IN ENHANC--K,CCALL(K),L,N,TEMP(L),CCALL(N),', CCCC 1 'XDATA(K),XDATA(N),DATA(N),WT(L),WTOTAL,SUM'/ CCCC 2 I6,2X,A8,2I6,2X,A8,2X,A8,6F8.2) D ELSE C D IF(IPRINT.EQ.1)THEN D WRITE(KFILDO,238) D238 FORMAT(' ') D IPRINT=0 D ENDIF C D WRITE(KFILDO,239)TEMP(L),TEMPST D239 FORMAT(' MISSING DATA FOR STATION ',A8, D 1 ' ENHANCING 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 ENHANC', 1 ' STATION AVERAGE LIST. AVERAGE ',A8, 2 ' WITHOUT IT.') ISTOP(6)=ISTOP(6)+1 IEND=NSTA IPRINT=1 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 SAVE=XDATA(K) XDATA(K)=XDATA(K)+SUM/WTOTAL C CCCC WRITE(KFILDO,253)K,CCALL(K),SAVE,XDATA(K),WTOTAL CCCC 253 FORMAT(' AT 253--K,CCALL(K),SAVE,XDATA(K),WTOTAL', CCCC 1 I5,2X,A8,3F8.2/) C ELSE WRITE(KFILDO,255)TEMPST 255 FORMAT(' ****COULD NOT FIND ANY STATIONS IN ENHANC', 1 ' STATION LIST. LEAVE ENHANC STATION ',A8, 2 ' AT ORIGINAL VALUE.') ISTOP(6)=ISTOP(6)+1 IPRINT=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 ENHANC 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 ENHANC STATION ',A8, 1 ' IN STATION LIST. THEREFORE, IT IS NOT USED.') ISTOP(6)=ISTOP(6)+1 IPRINT=1 GO TO 201 C 300 CONTINUE C CCCC WRITE(KFILDO,325)(K,CCALL(K),XDATA(K),LTAG(K),K=1,NSTA) CCCC 325 FORMAT(/,' IN ENHANC AT 325--(K,CCALL(K),XDATA(K),LTAG(K)',/, CCCC 1 4(I14,1X,A8,1X,F8.2,I4)) C 350 CLOSE(UNIT=KFILEN) C KFILEN IS CLOSED IN CASE THE UNIT NUMBER IS USED SOMEWHERE C ELSE (E.G., IN BOGUS) AND THERE IS A CONFLICT. CALL TIMPR(KFILDO,KFILDO,'END ENHANC ') RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'ENHANC',STATE) ISTOP(1)=ISTOP(1)+1 ISTOP(6)=ISTOP(6)+1 IER=777 GO TO 350 END