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