SUBROUTINE AUGMTO(KFILDO,KFIL10,IP16,MDATE,ID,IDPROJ,PLAIN, 1 CCALL,XPL,YPL,STALAT,STALON,LNDSEA, 2 TEMP,MOS,NOB,NSTA,ND1, 3 LSTORE,LITEMS,ND9, 4 IS0,IS1,IS2,IS4,ND7, 5 IPACK,IWORK,ND5, 6 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,NFETCH, 7 L3264B,ISTOP,IER) C C NOVEMBER 2013 GLAHN TDL MOS-2000 C NOVEMBER 2013 GLAHN REVISED SO VARIABLES CAN BE MIXED; C MODIFIED TEMP( , ) TO TEMP( , , ) C DECEMBER 2013 GLAHN ALLOWED MATCHING LAKE WITH LAKE C OR OCEAN C MARCH 2014 GLAHN CHANGES TO LET DO 200 LOOP EXECUTE C WHEN MOS NOT AVAILABLE. C APRIL 2014 GLAHN INCREASED 2ND DIMENSION OF TEMP( , , ) C APRIL 2014 GLAHN ADDED MOS AND NOB TO CALL AND IN C CODE C JUNE 2014 GLAHN REMOVED IER=0 TO RETURN WITH ERROR. C C PURPOSE C AUGMTO IS CALLED FROM AUGMT2 TO ADJUST THE OBS (IOB C LEVEL OF AUGMENTATION FOR LAMP) TO MOS (THE MOS LEVEL C OF AUGMENTATION FOR LAMP) OVER WATER AND OVER AN AREA C IN CANADA. C C THERE ARE NO LAMP FORECASTS OVER WATER AND CANADA, SO THE C OBS ARE ADJUSTED TO MOS BY ESTABLISHING A TREND FROM C PROJECTION 1 TO PROJECTION IDPROJ, THE ONE BEING DEALT C WITH, AND APPLYING THAT TREND TO THE OBS. IT IS EASIER C TO USE PROJECTION 1 AS THE BASE RATHER THAN HOUR 0, AND C THIS ALLOWS THE OBS TO BE USED UNCHANGED (OVER WATER AND C CANADA) FOR PROJECTION 1, WHICH IS PROBABLY DESIRABLE C FOR CONTINUITY. C C WHEN MOS IS NOT AVAILABLE, THE PROCESS WILL DELETE OBS C OVER CANADA AND WATER FOR PROJECTIONS > 1, ELSE THEY C WOULD BE USED UNCHANGED FOR ALL LAMP PROJECTIONS. C HOWEVER, THE OBS WILL BE USED UNADJUSTED OVER CANADA C AND WATER FOR PROJECTION 1, JUST AS THEY WOULD BE IF C MOS WERE AVAILABLE. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL OR RANDOM ACCESS C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT/OUTPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP16 C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWGTS,A RANDOM ACCESS FILE IS WRITTEN C THROUGH PAWRAC, OR A FILE IS WRITTEN TO C INTERNAL STORAGE BY GSSTORE. (INPUT) C MDATE = DATE/TIME, YYYYMMDDHH, OF THE CYCLE OF THE C DATA BEING PROCESSED. (INPUT) C ID = ID( ) IN THE CALLING PROGRAM OF THE VARIABLE C BEING ANALYZED. (INPUT) C IDPROJ = THE PROJECTION. (INPUT) C PLAIN = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLE C IN ID( ). (CHARACTER*32) (INPUT) C CCALL(K) = CALL LETTERS OF STATIONS BEING DEALT WITH C (K=1,NSTA). (CHARACTER*8) (INPUT) C XPL(K) = THE IX POSITIONS OF STATION K IN GRIDLENGTHS C AT MESH LENGTH MESHB (K=1,NSTA) C YPL(K) = THE JY POSITIONS OF STATION K IN GRIDLENGTHS C AT MESH LENGTH MESHB (K=1,NSTA) C STALAT(K) = LATITUDE OF STATIONS IN DEGREES N (K=1,NSTA). C (INPUT) C STALON(K) = LONGITUDE OF STATIONS IN DEGREES W (K=1,NSTA). C (INPUT) C LNDSEA(K) = LAND/SEA INFLUENCE FLAG FOR EACH STATION C (K=1,NSTA). 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 NSTA = NUMBER OF STATIONS BEING USED; THE NUMBER C OF VALUES IN TEMP( , ,1). (INPUT) C ND1 = FIRST DIMENSION OF LNDSEA( ), XPL( ), AND C YPL( ). (INPUT) C TEMP(K,LL,NN) = TEMPORARY ARRAY FOR AUGMENTING XDATA( ) (LL=1,4) C (NN=1,2) (K=1,NSTA). THE THREE VALUES OF J ARE C FOR VALUES FROM THE 1ST, 2ND, AND 3RD LEVELS OF C AUGMENTATION, RESPECTIVELY. NN=1 FOR AUGMENTATION C VALUES AND NN=2 TAKES VALUES: C 0 FOR UNADJUSTED C 1 FOR ADJUSTED IN USUAL WAY C 2 FOR MOS TREND ADJUSTED C (INTERNAL) C MOS = THE COLUMN IN TEMP( , , ) WHERE MOS FORECASTS C RESIDE. (INPUT) C NOB = THE COLUMN IN TEMP( , , ) WHERE THE AUGMENTING C OBS RESIDE. (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C IN INTERNAL STORAGE (L=1,12) (J=1,LITEMS). C L=1,4--THE 4 ID'S FOR THE DATA. C (INPUT/OUTPUT) 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 IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C (INPUT) C IPACK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), WORK( ), AND DATA( ). 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 LASTL = THE LAST LOCATION IN CORE( ) USED. RETURNED C FROM GSTORE. (INTERNAL) C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. (INPUT) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK C IN INTERNAL RANDOM ACCESS STORAGE. RETURNED C FROM GSTORE. (INTERNAL) C NSTORE = NUMBER OF TIMES A RECORD HAS BEEN STORED TO C INTERNAL STORAGE. (INPUT/OUTPUT) C NFETCH = NUMBER OF TIMES A RECORD HAS BEEN FETCHED FROM C INTERNAL STORAGE. (INPUT/OUTPUT) 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 AN ERROR C OCCURS. C ISTOP(2) IS INCREMENTED WHEN LESS THAN C 200 STATIONS ARE AVAILABLE FOR AN C ANALYSIS. C ISTOP(3) IS INCREMENTED WHEN A DATA RECORD C CANNOT BE FOUND. C (INPUT/OUTPUT) C IER = ERROR CODE. C 0 = GOOD RETURN. C (OUTPUT) C OTEMP(K) = THE VALUES OF MOS FOR THE FIRST PROJECTION C (K=1,NSTA). READ FROM INTERNAL STORAGE. C (AUTOMATIC) (INTERNAL) C RACK = FOR HOLDING PLAIN LANGUAGE FOR WRITING. C (CHARACTER*32) (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C TIMPR, GFETCH, GSTORE C CHARACTER*8 CCALL(ND1) CHARACTER*32 PLAIN,RACK C DIMENSION LNDSEA(ND1),XPL(ND1),YPL(ND1),STALAT(ND1),STALON(ND1), 1 TEMP(NSTA,4,2) DIMENSION OTEMP(NSTA) C OTEMP( ) IS AN AUTOMATIC ARRAY. DIMENSION IPACK(ND5),IWORK(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION ID(4),LD(4),ISTOP(3) C CALL TIMPR(KFILDO,KFILDO,'START AUGMTO ') C IER=0 C LD(1)=ID(1) LD(2)=910000 LD(3)=(ID(3)/1000)*1000+1 LD(4)=ID(4) C IF(IDPROJ.EQ.1)THEN C C WRITE THE MOS COLUMN OF TEMP( , ,1) (MOS FORECASTS) TO C INTERNAL STORAGE. THESE 1ST PROJECTION MOS FORECASTS C ARE NEEDED FOR EACH FOLLOWING LAMP PROJECTION. C CALL GSTORE(KFILDO,KFIL10,LD,0,LSTORE,ND9,LITEMS, 1 TEMP(1,MOS,1),NSTA,1,0,MDATE, 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C "NSLAB" IS STORED AS ZERO SIGNIFYING VECTOR DATA. C THE RECORD WRITTEN WILL HAVE THE SAME ID AS THE C GRID EXCEPT THE 2ND WORD = 910000. C IF(IER.EQ.0)THEN C IF(IP16.NE.0)THEN RACK(1:32)=PLAIN(1:32) RACK(29:32)='MOS1' WRITE(IP16,110)(LD(JJ),JJ=1,4), 1 RACK,MDATE 110 FORMAT(/' WRITING DATA TO UNIT KFIL10',3I10.9,I10.3,3X, 1 A32,' FOR DATE',I12) ENDIF C ELSE C A DIAGNOSTIC WILL HAVE OCCURRED IN GSTORE. WRITE(KFILDO,115)(LD(JJ),JJ=1,4) 115 FORMAT(/' ****ERROR WRITING VARIABLE',3(1X,I9.9),1X,I10.3, 1 ' TO INTERNAL STORAGE IN AUGMTO.',/, 2 ' TREND FOR MOS CANNOT BE ESTABLISHED.', 3 ' OBSERVATIONS WILL NOT BE ADJUSTED FOR LATER', 4 ' PROJECTIONS. PROCEEDING.') ISTOP(1)=ISTOP(1)+1 ENDIF C GO TO 210 C ELSE C C RETRIEVE THE MOS FORECASTS FOR PROJECTION 1. C CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,OTEMP,NSTA, 2 NWORDS,NPACK,MDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,120)(LD(J),J=1,4) 120 FORMAT(/' ****COULDN''T FETCH DATA ',4I10, 1 ' FROM INTERNAL STORAGE IN AUGMTO.',/, 2 ' TREND FOR MOS CANNOT BE ESTABLISHED.', 3 ' PROCEEDING. OBS WILL NOT BE USED.') ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 C OTEMP( ) WILL HAVE BEEN RETURNED AS 9999. ELSEIF(NWORDS.NE.NSTA)THEN WRITE(KFILDO,125)NWORDS,NSTA 125 FORMAT(/' ****NUMBER OF WORDS =',I8,' RETURNED FROM', 1 ' GFETCH IN AUGMTO NOT EQUAL TO NSTA =',I8, 2 '. PROCEEDING. OBS WILL NOT BE USED.') C C DO NOT USE THE VALUES READ. C DO 130 K=1,NSTA OTEMP(K)=9999. 130 CONTINUE C ENDIF C ENDIF C C THIS SECTION WILL FOR EVERY OB NOT ALREADY ADJUSTED: C (1) FIND THE CLOSEST TWO MOS STATIONS, OCEAN WITH C OCEAN, LAKE WITH LAKE OR OCEAN, LAND WITH LAND. C FOR THIS PURPOSE, THE CLOSE STATION CAN BE ITSELF. C LAKE USES OCEAN DATA FOR TRENDING OVER LAKE C OKEECHOBEE WHERE THERE IS NO MOS. C (2) USE THE MOS TREND FROM PROJECTION 1 IN OTEMP(K) AND C PROJECTION IDPROJ IN TEMP(K,MOS,1). C (3) APPLY THAT TREND TO THE OB, AND INSERT INTO C TEMP(K,NOB,1). C (4) WHEN A TREND CANNOT BE ESTABLISHED (AT LEAST ONE C NEIGHBOR CANNOT BE FOUND), THE OB IS DISCARDED. C DO 200 K=1,NSTA C IF(TEMP(K,NOB,1).GT.9998.5)GO TO 200 C THE OB IS MISSING, SO CANNOT BE TRENDED. NOTE THAT AUGMTO C IS CALLED ONLY FOR LAMP. IF(TEMP(K,NOB,2).EQ.1)GO TO 200 C WHEN TEMP( ,2,2) IS 1, THE OB HAS ALREADY BEEN ADJUSTED BY C LAMP, SO DO NOT TREND IT. THIS COULD HAPPEN OVER THE C LAKES OR CANADA. C C THIS FINDS NEIGHBORS OF TYPES 0 AND 3, AND FOR TYPE 9 IN AN C AREA OF CANADA (COMPRISED OF TWO RECTANGLES). NOTE THAT C STATIONS OUTSIDE THIS AREA CAN BE USED FOR NEIGHBORS. C IF((LNDSEA(K).LE.3).OR. 1 (((STALAT(K).GE.50.AND.STALON(K).GE.85.AND.STALON(K).LE.130) 2 .OR. 3 (STALAT(K).GE.47.5.AND.STALON(K).GE.55.AND.STALON(K).LE.85)) 4 .AND.LNDSEA(K).EQ.9))THEN CALL CLOSO(XPL,YPL,LNDSEA,OTEMP,NSTA,ND1,TEMP,K,LS1,LS2) C D WRITE(KFILDO,135)CCALL(K),LNDSEA(K),TEMP(K,MOS,1),TEMP(K,NOB,1) D135 FORMAT(' AT 135 IN AUGMTO--', D 1 'CCALL(K),LNDSEA(K),TEMP(K,MOS,1),TEMP(K,NOB,1)',/, D 2 2X,A8,I4,2F8.2) C IF(LS1.NE.-9999.AND.LS2.NE.-9999)THEN TREND=(TEMP(LS1,1,1)-OTEMP(LS1)+ 1 TEMP(LS2,1,1)-OTEMP(LS2))/2. C BOTH MOS NEIGHBORS ARE THERE TO ESTABLISH TREND. C D WRITE(KFILDO,137) D 1 CCALL(LS1),LNDSEA(LS1),TEMP(LS1,1,1),TEMP(LS1,2,1), D 2 OTEMP(LS1), D 3 CCALL(LS2),LNDSEA(LS2),TEMP(LS2,1,1),TEMP(LS2,2,1), D 4 OTEMP(LS2) D137 FORMAT(' AT 137 IN AUGMTO--', D 1 'CCALL(LS1),LNDSEA(LS1),TEMP(LS1,1,1),TEMP(LS1,2,1),', D 2 'OTEMP(LS1)', D 3 'CCALL(LS2),LNDSEA(LS2),TEMP(LS2,1,1),TEMP(LS2,2,1),', D 4 'OTEMP(LS2)'/ D 5 2(2X,A8,I4,3F8.2)) C ELSEIF(LS1.NE.-9999)THEN TREND=TEMP(LS1,1,1)-OTEMP(LS1) C IF ONLY ONE NEIGHBOR IS FOUND, IT WILL BE LS1. NORMALLY, C THIS IS RARE. C D WRITE(KFILDO,138) D 1 CCALL(LS1),LNDSEA(LS1),TEMP(LS1,1,1),TEMP(LS1,2,1), D 2 OTEMP(LS1) D138 FORMAT(' AT 138 IN AUGMTO--', D 1 'CCALL(LS1),LNDSEA(LS1),TEMP(LS1,1,1),TEMP(LS1,2,1),', D 2 'OTEMP(LS1)'/ D 3 2X,A8,I4,3F8.2) ELSE TREND=9999. C TREND CANNOT BE ESTABLISHED. ENDIF C C APPLY THE TREND TO THE OBS IN TEMP(K,NOB,1). IF A TREND C CANNOT BE ESTABLISHED, WEED OUT THE OB. THIS SHOULD BE C RARE. C IF(TREND.LT.9998.5)THEN TEMP(K,NOB,1)=TEMP(K,NOB,1)+TREND TEMP(K,NOB,2)=2 ELSE TEMP(K,NOB,1)=9999. TEMP(K,MOS,2)=0 ENDIF C CCCC IF(LNDSEA(K).GE.6)THEN CCCC WRITE(KFILDO,139)CCALL(K),STALAT(K),STALON(K),LNDSEA(K), CCCC 1 TEMP(K,MOS,1),TEMP(K,MOS,2), CCCC 2 TEMP(K,NOB,1),TEMP(K,NOB,2) CCCC 139 FORMAT(' AT 139 IN AUGMTO--', CCCC 1 'CCALL(K),STALAT(K),STALON(K),LNDSEA(K),', CCCC 2 'TEMP(K,MOS,1),TEMP(K,MOS,2)', CCCC 3 'TEMP(K,NOB,1),TEMP(K,NOB,2 ',/,A8,2F8.2,I4,4F7.1) CCCC ENDIF ENDIF C 200 CONTINUE C CCCC DO 202 K=1,NSTA CCCC WRITE(KFILDO,201)CCALL(K),STALAT(K),STALON(K),LNDSEA(K), CCCC 1 TEMP(K,MOS,1),TEMP(K,NOB,1) CCCC 201 FORMAT(/' END OF AUGMTO--CCALL(K),STALAT(K),STALON(K),LNDSEA(K),', CCCC 1 'TEMP(K,MOS,1),TEMP(K,NOB,1) ',A8,2F8.2,I4,2F7.1) CCCC 202 CONTINUE C 210 CONTINUE C CCCC WRITE(KFILDO,211)IER CCCC 211 FORMAT(/' LEAVING AUGMTO WITH IER =',I6) C CALL TIMPR(KFILDO,KFILDO,'END AUGMTO ') C RETURN C END