SUBROUTINE AUGMT2(KFILDO,KFIL10,IP16,KFILAU,FLAUG,NAREA, 1 ICYCLE,MDATE,ID,IDPARS,JD, 2 PLAIN,IBACK,NHRRUN,IDAY,MONTH, 3 CCALL,NAME,XDATA,LNDSEA,STALAT,STALON, 4 QUALST,LTAG,LTAGPT,MTAGPT,NTAGPT,SDATA,NSTA,ND1, 5 NUMAUG,NUMOBS,IOBS, 6 IPREX1,IPREX2,PREX3,PREX5, 7 MESHB,XPL,YPL,NXL,NYL, 8 R,RSTAR, 9 LSTORE,ND9,LITEMS, A IS0,IS1,IS2,IS4,ND7, B IPACK,IWORK,DATA,ND5, C CORE,ND10,NBLOCK,NSTORE,NFETCH, D L3264B,ISTOP,IER) C C OCTOBER 2010 GLAHN TDL MOS-2000 C ADAPTED FROM AUGMT1 AND AUGMT3 c OCTOBER 2010 GLAHN ADDED TWO LEVELS OF AUGMENTATION C OCTOBER 2010 GLAHN REMOVED XLAPSE( ) C OCTOBER 2010 GLAHN CHANGED * TO + COMPUTATION OF F C OCTOBER 2010 GLAHN STATEMENT 1116 AND TRANSFER TO IT C ADDED; CHANGING OF QUALST( ) FOR C 1ST AUGMENTATION CYCLE ELIMINATED; C CHANGED M TO MM IN DO 205 LOOP; C SET DATUM TO MISSING WHEN QUALITY C WEIGHT =0 C OCTOBER 2010 GLAHN ADDED LL2WAT, LL2LND C OCTOBER 2010 GLAHN INITIALIZED LTAGPT( ) C OCTOBER 2010 GLAHN ADDED IPTWT AND PRINT OF WEIGHT; C ADDED COUNT AND PRINT OF BASE STA C OCTOBER 2010 GLAHN ADDED MESHB, XPL, YPL, NXL, NYL, C R, RSTAR; CODE TO LIMIT AREA OF C AUGMENTATION AND COUNT OF STATIONS C OCTOBER 2010 GLAHN ADDED COUNTS FOR LAND/INLAND WATER C NOVEMBER 2010 GLAHN ADDED READING FLAUG ONLY ONCE C NOVEMBER 2010 GLAHN ADDED DIAGNOSTIC 2065; COUNT OF C LL1LIN WHEN LL EQ.1 AND LNDSEA( ) C EQ 6 C AUGUST 2011 GLAHN MODIFIED TO REPLACE LAND STATIONS C ABOVE 50 DEG N ON 1ST PASS, EVEN C IF NOT LIST PRESENT; INCLUDED C STALAT( ) AND STALON( ) IN CALL C AUGUST 2011 GLAHN CHANGED LTAGPT( ) DEFINITION; C CHANGED WHEN 1114 GETS PRINTED; C ELIMINATED PREX4, PREX5 c AUGUST 2011 GLAHN WHEN BOTH 3-H VALUES OF MOS ARE C NECESSARY FOR INTERPOLATION, C AND ONE IS MISSING, DATA( )=9999 C IN DO 115 LOOP; CHECK ON ND1 AT C 1395 C SEPTEMBER 2011 GLAHN ADDED CHECK ON MONTH AT 103; C CORRECTED INTERPOLATION ALGORITHM C FOR DAY OF MONTH NEAR 2061; PUT C TEMP( ) IN SAVE STATEMENT C SEPTEMBER 2011 GLAHN MODIFIED ALGORITHM TO FIND MOS C DATES AND PROJECTIONS FOR LAMP C SEPTEMBER 2011 GLAHN ADDED TO DIAGNOSTIC PRINT AT 255 C SEPTEMBER 2011 GLAHN ADDED JTWO; REVISED TO NOT REPLACE C OCEAN OR LAKE WITH OBS; TO REPLACE C LAKE/LAND WITH MOS OR OBS C SEPTEMBER 2011 GLAHN ELIMINATED MONTAB( , ), IDYTAB( , ) C NOVEMBER 2011 GLAHN CHANGED EKDMOS DD'S FROM 76 TO 61 PER C J. WAGNER, DATA STATEMENT AND AT 111 C TO AGREE WITH AUGMT1 C MAY 2012 GLAHN CHANGE TO DIAGNOSTIC 2051 C JUNE 2012 GLAHN ADDED PREX1 TO CALL; WEIGHT MOS C 1-WEIGHT OF OBS FOR PROJECTION C JULY 2012 GLAHN ADDED COMMENTS; DIAGNOSTIC 2065; C RENUMBERED SOME OTHER DIAGNOSTICS C JULY 2012 GLAHN CHANGED QUAL TO QUAL2; MOVED C CALCULATIONS OUT OF IF STATEMENT; C SEPARATED REPLACEMENT COUNTS OCEAN C LAKES C JULY 2012 GLAHN REVERSED LL=1,0,-1 TO LL=1,2 C JULY 2012 GLAHN ADDED 3RD LEVEL OF AUGMENTATION C JULY 2012 GLAHN ADDED ARRAY KTLLB( , ) C AUGUST 2012 GLAHN ADDED USE OF PREVIOUS OBS TOSSED C FILE C SEPTEMBER 2012 IM ADDED MOS WATER POINTS FOR THE 2ND C AUGMENTATION TO GOBS PROCESS; C MODIFIED IF STATEMENT FOR C KOUNT AT 2040. NOTE: ONCE LAMP WATER C POINTS ARE AVAILABLE WITH SINGLE C STATION EQUATION DEVELOPMENT OVER C WATER, WE NEED TO GO BACK TO ORIGINAL C OF "IF(KOUNT.GE.2)THEN"; MODIFIED C IREPL PROCEDURE C SEPTEMBER 2012 IM ADDED QC PROCEDURE FOR THE SUM C COMPUTATION TO NOT USE BAD DATA FOR C T/TD (NEED TO ADD FOR WINDS LATER) C SEPTEMBER 2012 IM CORRECTED (JTAU1.LT.5) TO (JTAU1.LT.6) C SEPTEMBER 2012 IM REMOVED THE PROCEDURE FOR "IF THE C LEVEL IS NOT TO BE DONE OR FAILED, C SKIP TO THE END OF THE LL LOOP" C IN READING THE PAIR LIST C SEPTEMBER 2012 IM ADDED SPECIAL TREATMENT FOR QUAL2 C WHERE NO BASE STATIONS ARE AVAILABLE C OVER CANADA C OCTOBER 2012 IM ADDED ONE MORE INITIALIZATION OF C TEMP( , ) C JANUARY 2013 IM ADDED FINAL VALUES TO DATA TPROJ C FOR T AND TD C JUNE 2013 IM MODIFIED FORMAT STATEMENT C 255 AND 1113 FOR INTEL COMPILER C AUGUST 2013 GLAHN ADDED TO ITABLE( , ) FOR WIND AND C TOTAL WIND C AUGUST 2013 GLAHN REMOVED TOTAL WIND U AND V PER SUN C SEPTEMBER 2013 GLAHN INSERTED TPROJ( ) FOR LAMP U, V, S; C INCREASED INDENTATION ON SOME C CONTINUATION STATEMENTS; OMITTED C CHECKING NUMOBS WITH TOTAL FOR C ANALYSIS; CORRECTED IFIRST COUNT C OCTOBER 2013 GLAHN ADDED DIAGNOSTIC 1086; MODIFIED 1083 C OCTOBER 2013 GLAHN MODIFIED TO USE FULL WEIGHT OF MOS C OVER WATER FOR LAMP C OCTOBER 2013 GLAHN ADDED NTAGPT( ) TO CALL C NOVEMBER 2013 GLAHN ADDED IUSE( ); CHANGED TO LOOK FOR C QC DATA WITH ID(2) = 940000 VICE C PASS NUMBER C NOVEMBER 2013 GLAHN ADDED CALL TO AUGMTO; ADDITIONS TO C CALL C NOVEMBER 2013 GLAHN ADDED DIAGNOSTIC 2015 C NOVEMBER 2013 GLAHN CHANGED PLACEMENT OF 2050 C NOVEMBER 2013 GLAHN MODIFIED IREPL FOR REPLACEMENT C NOVEMBER 2013 IM/GLAHN REMOVED SPECIAL TREATMENT FOR C LAKES AT 2050 C NOVEMBER 2013 GLAHN REARRANGED SECTION SETTING IREPL C NOVEMBER 2013 GLAHN SET IREPL FOR OBS OVER WATER C NOVEMBER 2013 GLAHN MODIFIED PER SUN/GLAHN AGREEMENT C NOVEMBER 2013 GLAHN TEMP( , ) DIMENSION CHANGED TO C TEMP( , , ); CHANGED WHERE KTLLB( ,) C IS COUNTED; OMITTED LAMP PROJECTIONS C 2 THROUGH 9 SECTION; ADDED DIMENSION C TO IREPL C DECEMBER 2013 GLAHN MODIFIED LTAG( ) BEFORE WRITING TO C PRESERVE LAMP FOR NEXT RUN; ADDED C PARTIAL ADAPTATION TO LAMP FOR FIRST C 2 PROJECTIONS C DECEMBER 2013 GLAHN ADDED OBS TOTAL WIND AND DIAGNOSTIC C WITH DIAG(NSTA,4) C JANUARY 2014 GLAHN REMOVED REDUNDANCY COUNTING KTLLB( , ) C JANUARY 2014 GLAHN ESTABLISHED KTAVG( , ) C JANUARY 2014 GLAHN IMPLEMENTED IPREX5 = 2 C JANUARY 2014 IM MODIFIED FORMAT STATEMENT C 281 FOR INTEL COMPILER C JANUARY 2014 GLAHN MODIFIED TEST ON SDATA( ) AND SET C LTAG( ) = 3; LTAG( ) IN CALL C FEBRUARY 2014 GLAHN PUT CHECK ON SDATA( ) IN SEPARATE C LOOP AND MOVED ABOVE OTHER CHECKS c FEBRUARY 2014 GLAHN MODIFIED TO KEEP MOS EVEN IF OBS C TOSSED PREVIOUSLY C FEBRUARY 2014 GLAHN DEFINITION OF DATA READ WITH IOBS=1 C CHANGED; CHANGED LOCATION OF TEST ON C LTAG( ) = 4 AND NOW DEPENDS ON LL C FEBRUARY 2014 GLAHN SET LTAG( ) = 0 FOR MOS; LIMITED C ICANADA TO NAREA = 1 C FEBRUARY 2014 GLAHN MODIFIED TO OVERRIDE DICTIONARY C VALUE OF 0.212 FOR MESONET STATIONS C WHEN THE DATUM IS MOS C FEBRUARY 2014 GLAHN INSERTED TEST ON SDATA( ) AT 2014 C MARCH 2014 GLAHN ADDED CODE FOR LAMP TOTAL WIND C MARCH 2014 GLAHN ADDED DIAGNOSTICS TO COUNG -1, 3, 4 C MARCH 2014 GLAHN ADDED WORD 5 FOR LAMP TOTAL WIND C MARCH 2014 GLAHN ADDED ACCOMMODATION FOR TOTAL WIND C MOS INTERPOLATION C MARCH 2014 GLAHN REMOVED CHECK IN DO 2013 LOOP C MARCH 2014 GLAHN SKIPPED DO 253 LOOP FOR TOTAL WIND C APRIL 2014 GLAHN MODIFIED TPROJ FOR S, U, V, AND TW C APRIL 2014 GLAHN NEW ROUTINES TO SET IREPL( ); C ADDED WORD 5 FOR U- AND V-WIND AND C TEMPERATURE; REMOVED IUSE( ) C APRIL 2014 GLAHN MODIFIED CALL TO IRLMP, IROBS, IROBTW C APRIL 2014 GLAHN ADDED IOBTAG( ) AND ADDED TO TO C CALL TO IRLMP; STATEMENT NEAR 1251 C APRIL 2014 GLAHN EXPANDED ITABLE TO HOLD 10 IDS VICE 5 C APRIL 2014 GLAHN REARRANGED CODE FOR TOTAL WIND C APRIL 2014 GLAHN CHANGED FIRST DIMENSION OF TEMP( , , ) C CORRECTED ALLOCATION OF TEMP( , , ) C APRIL 2014 GLAHN DEFINED MOS AND NOB AND ADDED TO CALL C TO AUGMTO C APRIL 2014 GLAHN CHANGED IOBTAG TO IBTAG1; ADDED C IBTAG2; READ TWO PAST LTAG RECORDS C VICE 1; ADDED S2DATA( ) C MAY 2014 GLAHN REVISED READING LTAGS C MAY 2014 GLAHN REMOVED DIAGNOSTIC 230 C MAY 2014 GLAHN DEFINED LLM C MAY 2014 IM/GLAHN DELETED S2DATA( ); LTABLE( ) C MAY 2014 GLAHN CHANGED L.EQ.1.OR L.EQ.3 TO INCLUDE C U- AND V-WIND BELOW 125 ELIMINATING C OBS TOSSED C MAY 2014 GLAHN ADDED MTAGPT( ) C JUNE 2014 GLAHN ADDED SWITCH ON ICANADA FOR MOS TW C JUNE 2014 IM/GLAHN INCREASED 2ND DIMENSION OF DIAG C FROM 4 TO 5 C JUNE 2014 GLAHN KER DEFINED AND IER RETURNED = 666 C WHEN AUGMTO DID NOT RUN PROPERLY C JUNE 2014 GLAHN INSERTED CALL TO W3TAGE BEFORE STOPS C JUNE 2014 GLAHN REVISED IER/KER USE C JUNE 2014 GLAHN REVISED CORRECTION TO OBS FOR WIND C AUGUST 2014 IM/GLAHN REVISED TPROJ FOR WIND AND GUST C AFTER CHECKING WITH VERIFICATION C GRIDS C AUGUST 2014 IM/GLAHN REMOVED SPECIAL CORRECTION TO OBS C FOR WIND AFTER CHECKING WITH C VERIFICATION GRIDS C OCTOBER 2014 GLAHN ADDED FILLING LTAGPT( ) FOR OBS C GUSTS BELOW 9507 C OCTOBER 2014 GLAHN ADDED FILLING LTAGPT( ) AND NTAGPT( ) C FOR LAMP GUSTS BELOW 2516 C OCTOBER 2014 GLAHN MODIFIED TO REQUIRE ON-TIME GUSTS AND C MOS FOR OBS GUSTS TO COMPLETE, C STATEMENTS 1163, 1164; ELIMINATED C DIAGNOSTICS 913, 917, 9015 C NOVEMBER 2014 GLAHN REVISED W3TAG PER JUDY C DECEMBER 2014 IM/GLAHN CORRECTED TO GO BACK A CYCLE FOR C MOS FOR GUSTS C DECEMBER 2014 GLAHN ADDED A FEW COMMENTS C DECEMBER 2014 GLAHN ADDED ITABLE( , ) ENTRY FOR READING C PREVIOUS LTAG( ) FOR MOS TEMP & DP C OCTOBER 2015 HUANG MODIFIED OPEN STATEMENT FOR C OPERATIONS; ALSO COMMENTED OUT WRITE C STATEMENTS FOR STATION "K49B"; C UNCOMMENTED THE WRITE STATEMENT AT C 9095; CORRECTED TYPO AT 2760; CHANGED C "STOP 910" TO "STOP 9999" AT THE END. C DECEMBER 2015 GLAHN ACCOMMODATED BLANK FILE AT 127; C CHANGED SAVFL INITIALIZATION; C ALLOWED 0 AUGMENTATION LEVELS AT 1025; C ACCOMMODATED LTAG -3H FOR TEMP C JANUARY 2016 GLAHN KER=1 FOR MAJOR ERROR CANCELLED WHEN C PREVIOUS LTAG( ) NOT FOUND BELOW 1083; C WHEN NUMAUG=0, SET LTAG( ) =-1 TO 4 C ABOVE 1085 C JANUARY 2016 GLAHN CHANGED IDCAT FROM 20 TO 24; ADDED C MOS S, U, V, AND G TO ITABLE( , ), C TMONTH( , ) AND TPROJ( , ) C JANUARY 2016 GLAHN INSERTED BLANK 917 C FEBRUARY 2016 GLAHN CHANGED MOS GUST ID 224385 VICE 380 C MARCH 2018 GLAHN CORRECTED 2760 PER LAMP VERSION; C CHANGED STOP 910 TO 9999 PER LAMP; C MODIFIED OPEN STATEMENT FOR OPS C NOVEMBER 2022 WAGNER UPDATED TPROJ AND EXTENDED CHECK OUT C TO 38 HOURS TO ALLOW MORE PROJECTIONS C TO FEED NBM. C JANUARY 2023 WAGNER UPDATED ITABLE TO ACCOMODATE LAMP C DD CHANGE FROM 05 TO 35 FOR MELD C T/TD/WSPD/UWND/VWND/WGST. C FEBRUARY 2024 HUANG FIXED A MISCOUNTED "DATA TPROJ" STATEMENT. C C PURPOSE C THE AUGMT^ SERIES OF ROUTINES IS TO PROVIDE A VALUE, C FABRICATED IN SOME MANNER, TO ANALYZE IN U405A WHEN C ONE DOES NOT EXIST. THIS PARTICULAR ONE AUGMT2 C CAN BE QUITE GENERAL AND AUGMENT FORECASTS WITH OTHER C FORECASTS, OBS WITH OBS, OR LAMP FOR FORECASTS WITH OBS C (ALL PROJECTIONS). IT HAS A WEIGHTING CAPABILITY C THAT AUGMT1 DOES NOT HAVE, BUT CAN BE USED INSTEAD OF C AUGMT1 WITH THE APPROPRIATE IDS AND WEIGHTS. THE C FOLLOWING ARE AUGMENTED WHEN ACTIVATED: C C NO. INPUT ELEMENT FROM C C 1 LAMP TEMPERATURE MOS TEMPERATURE FORECASTS C OBS CURRENT TEMPERATURE C 2 " DEW POINT MOS DEW POINT FORECASTS C OBS CURRENT DEW POINT C 3 " WIND SPEED OBS CURRENT WIND SPEED C 4 " U-WIND " " U-WIND C 5 " V-WIND " " V-WIND C 6 EKDMOS TEMPERATURE MOS MAX/MIN TEMPERATURE C 7 " DEW POINT " " " C 8 " MAX TEMP " " " C 9 " MIN TEMP " " " C 10 MOS TEMPERATURE " " " C 11 " DEW POINT " " " C 12 OBS TEMPERATURE OBS PREVIOUS HR TEMPERATURE C 13 " DEW POINT " " " DEW POINT C 14 LAMP CEILING HGT OBS CURRENT CEILING HGT C 15 " VISIBILITY " " " " C 16 OBS WIND SPEED OBS PREVIOUS HR WIND SPEED C MOS WIND SPEED C 17 " U-WIND OBS PREVIOUS HR U-WIND C MOS U-WIND C 18 " V-WIND OBS PREVIOUS HR V-WIND C MOS V-WIND C 19 OBS TOTAL WIND SP OBS PREVIOUS HR TOTAL WIND SP C MOS WIND SPEED c 20 LAMP TOTAL WIND SP LAMP GUSTS, MOS GUSTS, OBS C GUSTS C *******NOTE THAT NOT ALL OF THESE HAVE BEEN TESTED. MOST WORK C HAS BEEN ON OBS AND LAMP TEMP, DEWPOINT, AND WIND. C MODS CAN BE MADE AS NECESSARY. C C THE QUALITY WEIGHTS IN QUALST( ) CAN BE MODIFIED. C THERE CAN BE FOUR LEVELS OF AUGMENTATION. WHEN THERE ARE C TWO, THE WEIGHTS FOR EACH STATION ARE MODIFIED FOR ONLY C THE SECOND WHEN IPREX1 = 0, AND BOTH ARE MODIFIED WHEN C IPREX1 = 1. THE USE OF THE WEIGHTS IS CONTROLLED BY C PREX3. THE 3RD LEVEL IS TREATED AS A BACKUP FOR THE 2ND C LEVEL, EXCEPT FOR LAMP TOTAL WIND WHERE THE FOURTH IS C BACKUP TO THE THIRD. C C UP TO MAXSTA NEIGHBORS ARE FOUND IN THE PREPROCESSOR C U179 THAT MAY HAVE BOTH MOS AND AUXILIARY FORECASTS. C THESE ARE USED TO OBTAIN A BIAS OR OFFSET. THEN THAT C OFFSET IS APPLIED TO THE POINT WHICH DOES NOT HAVE A LAMP C OR EKDMOS FORECAST BUT DOES HAVE A MOS FORECAST. THIS C WORKS FOR EKDMOS MEAN OR EKDMOS PROBABILITIES. IT ALSO C WORKS FOR OBS AUGMENTED BY PREVIOUS HOUR. C C THE U179 FILE IS ALWAYS READ THE FIRST TIME THIS ROUTINE C IS ENTERED FOR A RUN. THE STATION LIST ON IT IS C COORDINATED WITH THE ONE BEING USED IN U155. BOTH THE C FILE NAME AND THE ID IN THE FIRST RECORD ARE SAVED. C ON SUBSEQUENT ENTIRES, THE FIRST RECORD IS READ, AND IF C THE FILE AND ID ARE THE SAME, IT NEED NOT BE READ. C C THE MDATE COMING IN IS THE CYCLE OF THE DATA, SO IF C TWO CYCLES ARE BEING ANALYZED TOGETHER, BOTH WILL BE C AUGMENTED. C C EXCEPT FOR MOS OR EKDMOS TEMP AND DEWPOINT AUGMENTED C BY MOS MAX OR MIN TEMPERATURE, THE PROJECTION OF THE C VARIABLE AND ITS AUGMENTED VARIABLE ARE THE SAME. C SPECIAL CODE IS NECESSARY FOR THESE EXCEPTIONS. BOTH C TEMP AND DEWPOINT CAN BE AUGMENTED BY MAX TEMP FOR C 5 SPECIFIC TIMES (WHICH VARY BY AREA, E.G., CONUS) C OR MIN TEMP FOR THE OTHER 3 TIMES. NOTE THE NON C SYMMETRIC AUGMENTATION. IT WAS THOUGHT THE MAX TEMP C WOULD, IN GENERAL, BE SMOOTHER AND FURNISH A BETTER C AUGMENTATION. HOWEVER, IN THE DEEP NIGHT, THE MIN C IS USED. C C THE SHORTEST PROJECTIONS ARE A PARTICULAR PROBLEM BECAUSE C THERE IS NO MAX OR MIN THAT PERTAINS TO THE SAME START C TIME. THEREFORE, AUGMT2 CYCLES AND GETS A PREVIOUS C CYCLE WITH A LONGER PROJECTION. THIS MEANS THAT A 12Z 6-H C MOS OR EKDMOS FORECAST (THE SHORTEST MADE) IS AUGMENTED C WITH A 30-H MAX FROM THE PREVIOUS CYCLE AND THE AVERAGED C FORECAST, AN 18-H FORECAST, IS AUGMENTED WITH A 42-H C MAX FORECAST. C C THE ITABLE FOR AUGMENTING MOS AND EKDMOS TEMPERATURE C AND DEWPOINT IS SET UP TO BE AUGMENTED BY MOS MAX AND C MIN. IF EKDMOS MAX AND MIN ARE TO BE USED TO AUGMENT, C THE ITABLE MUST BE CHANGED. AS OF 6/4/09, THE MAX C AND MIN USING CO-OP STATIONS WERE NOT AVAILABLE FOR C EKDMOS. C C IN U179, WHICH PREPARES THE AUGMENTING LIST, EVERY C STATION IN THE LONG LIST (WHICH INCLUDES THE SHORT LIST) C HAS A SET OF PAIRS. THIS MEANS THAT IF A STATION (IN C THE SHORT LIST) THAT NORMALLY HAS DATA IS MISSING, IT C WILL BE AUGMENTED, PROVIDED GE IPRNO OF ITS LIST C OF STATIONS ARE AVAILABLE. C C THERE IS AN HOURLY AND A MONTHLY WEIGHT PROVIDED FOR C EACH VARIABLE THAT CAN BE AUGMENTED AS WELL AS FOR C THE FORECAST PROJECTION UP TO 25 HOURS. THE MONTHLY C WEIGHTS ARE LINEARLY INTERPOLATED TO THE DAY. THE FINAL C WEIGHT IS THE PRODUCT OF THESE THREE AND THE INCOMING C QUALST( ), WHICH HAS HAD THE QUALWT(IQUAL(K,IQUALC)) C APPLIED. WHEN THERE ARE TWO LEVELS OF AUGMENTATION C (E.G., LAMP TEMPERATURE AUGMENTED BY MOS TEMPERATURE C THEN BY OBS), THE WEIGHTS ARE NOT MODIFIED FOR THE C FIRST LEVEL WHEN IPREX1 = 0. C C THE FIRST LEVEL OF AUGMENTATION FOR LAMP IS MOS AND C THE SECOND LEVEL IS OBS. OVER LAND (WHERE LAMP FORECASTS C EXIST), BOTH MOS AND OBS ARE ADJUSTED TO LAMP. OVER C WATER (WHERE THERE IS NO LAMP), THIS CANNOT BE DONE. C FOR MOS THIS IS OK, BECAUSE THEY ARE FORECASTS AND C VARY WITH PROJECTION. FOR PROJECTION 1, THE OBS ARE C PROBABLY OK, BUT FOR LARGE PROJECTIONS CANNOT BE USED C UNADJUSTED. THIS IS HANDLED BY FINDING THE CLOSEST C TWO MOS STATIONS TO EACH OB OF THE SAME TYPE (OCEAN OR C LAKE), ESTABLISHING A TREND FROM PROJECTION ONE TO THE C PROJECTION HOUR FOR MOS AND APPLYING IT TO THE OBS. C THIS ADJUSTMENT IS DONE IN AUGMTO. C C FOR TOTAL WIND, LAMP AND MOS CAN HAVE A GUST VALUE. C IT SHOULD BE GREATER THAN THE SPEED. THE GUST CAN C BE MISSING (9999) OR BE ZERO (NO GUST). ZERO AND C MISSING ARE TREATED DIFFERENTLY FOR AUGMENTATION. C FOR INSTANCE, A MOS GUST OF ZERO WILL CAUSE A LATER C AUGMENTATION LEVEL TO NOT BE USED (E.G., 1-H OLD OBS). C C THE SAME DICTIONARY IS USED FOR GLAMP AS FOR GOBS. C FOR MESONET STATIONS, THE DEFAULT VALUE FOR WEIGHTING C IS 0.212 FOR WIND (NOT TEMP/DP). 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 KFILAU - THE UNIT NUMBER FOR THE FILE HOLDING THE C AUXILIARY DATA. (INPUT) 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 KFILAU = THE UNIT NUMBER FOR THE FILE HOLDING THE C AUXILIARY DATA. THESE ARE THE MATCHES BETWEEN C THE LONG AND SHORT LISTS. (INPUT) 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 GSTORE. (INPUT) C FLAUG = THE FILE NAME OF THE AUXILIARY DATA. C (SEE FKILAU) (CHARACTER*60) (INPUT) C NAREA = THE AREA OVER WHICH THE ANALYSIS IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, C 4 = PUERTO RICO. C ICYCLE = CYCLE OF RUN = JDATE(4) IN CALLING PROGRAM. C RANGE = 0 TO 23. (INPUT) C MDATE = DATE/TIME, YYYYMMDDHH, OF THE CYCLE OF THE C DATA NEEDED (INPUT) C ID(J) = 4-WORD ID OF VARIABLE TO PROVIDE FIRST GUESS 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 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 C 1 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), C J=13--I (INTERPOLATION TYPE), C J=14--S (SMOOTHING INDICATOR), AND C J=15--G (GRID INDICATOR). 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 B = IDPARS(3, ), C T = IDPARS(8,), C I = IDPARS(13, ), C S = IDPARS(14, ), C G = IDPARS(15, ), AND C THRESH( ). C NOT ACTUALLY USED. (INPUT) C PLAIN = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLE C IN ID( ). (CHARACTER*32) (INPUT) C IBACK = THE NUMBER OF CYCLES TO GO BACK FOR AUGMENTATION C FORECASTS AS NECESSARY. IBACKN IN CALLING C PROGRAM. (INPUT) C NHRRUN = THE HOURS PRIOR TO THE RUN TIME IN NDATE TO C INCLUDE IN THE ANALYSIS IN THE CALLING PROGRAM. C USED IN AUGMT2 TO UPDATE THE TAU. (INPUT) C IDAY = THE DAY OF THE MONTH. (INPUT) C MONTH = THE NUMBER OF THE MONTH. (INPUT) C CCALL(K) = CALL LETTERS OF STATIONS BEING DEALT WITH C (K=1,NSTA). (CHARACTER*8) (INPUT) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20) C (INPUT) C XDATA(K) = DATA VALUES ON INPUT; AUGMENTED VALUES C ON OUTPUT (K=1,NSTA). (INPUT/OUTPUT) 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 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 QUALST(K) = THE WEIGHTING FOR EACH STATION AND AFTER C MODIFICATION IN AUGMT2 FOR ONLY THE STATIONS C TO USE IN AUGMENTATION. QUALST( ) IS C INITIALIZED IN U405A BEFORE EACH ENTRY TO C AUGMT2 TO THE VALUE IN THE STATION CONSTANT C FILE. (INPUT/OUTPUT) C LTAG(K) = DENOTES USE OF DATA CORRESPONDING TO CCALL(K). C +4 = TOSSED IN A PREVIOUS OBS RUN AND C MAINTAINED DOWNSTREAM. C +2 = NOT USED FOR ANY PURPOSE. FLTAG SETS C A VALUE +2 WHEN THE STATION LOCATION C IS MISSING. 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 (INCOMING). C LTAGRD SETS THIS TO +3 OR 4 TO INDICATE TO C NOT USE FOR THIS ANALYSIS. C -3 = ACCEPT THIS STATION ON EVERY PASS. THIS C FEATURE MAY OR MAY NOT BE IMPLEMENTED IN C THE CALLING PROGRAM. C (OUTPUT) C LTAGPT(K) = FOR STATION K (K=1NSTA), C ON INPUT: C 0 = INITIALIZED TO ZERO IN U405A. C ON OUTPUT: C 1 = AUGMENTED DATA (FIRST PASS) C 2 = AUGMENTED DATA (2ND,3RD, OR 4TH PASS) C (INTERNALLY MAY BE 3 FOR 3RD PASS) C 3 = BOGUS DATA C 0 = EVERYTHING ELSE C OUTPUT FOR SEVERAL USES FOR TYPE OF DATA. C (INPUT/OUTPUT) C MTAGPT(K) = THE SAME AS LTAGPT( ) BUT IT IS USED FOR SAVING C LTAGPT( ) FROM SPEED TO USE IN TW (K=1NSTA). C IN TW, LTAGPT( ) REFERS TO THE AUGMENTED SPEED, C THE STARTING POINT FOR TW. MTAGPT( ) REFERS C TO ONLY LAMP STATIONS. WHEN XDATA( ) = 9999., C MTAGPT( ) SET = 4. (INPUT/OUTPUT) C NTAGPT(K) = TAG FOR HOW AUGMENTATION IS MADE (K=1,NSTA). C 0 = NOT AUGMENTED. INCLUDES MISSING AND BASE C VALUES. C 1 = WEIGHTED AVERAGE OF 1ST AND 2ND LEVELS, BUT C ONLY WHEN IPREX5 EQ 1. THIS IS FOR LAMP C AVERAGE OF MOS AND OBS. C 2 = 1ST LEVEL, 2ND NOT THERE. THIS COULD BE C OBS FOR OBS ANALYSIS OR MOS FOR LAMP. C 3 = 2ND LEVEL, 1ST LEVEL NOT THERE. THIS IS C OBS FOR EITHER OBS ANALYSIS OR LAMP. C 4 = 1ST LEVEL WHEN IPREX5 = 0. THIS IS OBS C FOR OBS ANALYSIS OR MOS FOR LAMP. C OUTPUT BUT NOT ACTUALLY USED IN U405A. C (OUTPUT) C SDATA(K) = WORK ARRAY, TO HOLD FILE INDICATING C TOSSED OBS IN ANALYSIS OF OBS (K=1,NSTA). C THIS IS LTAG(K) FROM OBS. (INTERNAL) C NSTA = NUMBER OF STATIONS BEING USED; THE NUMBER C OF VALUES IN XDATA( ). (INPUT) C ND1 = FIRST DIMENSION OF XDATA( ) AND DIMENSION C OF FD1( ) AND SEVERAL VARIABLES. (INPUT) C NUMAUG = NUMBER OF LEVELS OF AUGMENTATION TO DO, C UP TO 4. THIS IS THE FIRST INPUT PARAMETER C ICAT( ) TO AUGMT2 AND ALLOWS CONTROL WITHOUT C MODIFYING AUGMT2. ZERO IS ALLOWED TO C ACCOMMODATE INITIALIZING LTAG( ) WITH C PREVIOUS VALUES WITHOUT AUGMENTAION. (INPUT) C NUMOBS = THE NUMBER OF OBS (2ND AND 3RD LEVELS OF C AUGMENTATION COMBINED) REQUIRED TO SCALE C BACK THE INFLUENCE OF MOS. (WHEN NUMBER C OF OBS LT NUMOBS, WEIGHT ON MOS = 1.) C (2ND ELEMENT IN AUGMT2 CONTROL LIST.) C (INPUT) C IOBS = 0 WHEN LTAGS( ) FROM A PREVIOUS RUN ARE C NOT NEEDED (ONLY OBS TEMP AND SPEED); C 1 = WHEN ONE SET OF LTAGS( ) IS NEEDED; AND C 2 - WHEN TWO SETS ARE NEEDED. THIS IS C LIMITED AT PRESENT TO TOTAL WIND AND C DEWPOINT. C (INPUT) C IPREX1 = FLAG TO SIGNIFY WHETHER TO WEIGHT MOS BY C PROJECTION: C 0 = NO, DEFAULT, C 1 = YES, C WEIGHT FOR 1ST LEVEL (MOS) = 1.-TPROJ( , ); C WEIGHT FOR 2ND LEVEL (OBS) = TPROJ( , ) C IPREX2 = THE NUMBER OF AUGMENTING STATIONS TO USE. C BECAUSE THIS WAS ADDED LATER, A ZERO DEFAULTS C TO 5, THE SETTING UNTIL NOVEMBER 15, 2009. C THE NUMBER ACTUALLY USED IS ALSO LIMITED BY C THE NUMBER IN THE LISTS PROVIDED BY U179. C THIS BECOMES IPRNO IN AUGMT2. (5TH ELEMENT C IN AUGMT2 CONTROL LIST) (INPUT) C PREX3 = FRACTION OF THE AUGMENTING VALUE TO APPLY C TO THE 2ND LEVEL. NORMALLY = 1. (INPUT) C PREX5 = SWITCH OF WEIGHTED AVERAGE OF 1ST AND 2ND C LEVELS OF AUGMENTATION. C 0 = DON'T WEIGHT; USE 1ST IF THERE, 2ND IF C 1ST LEVEL IS MISSING. C 1 = WEIGHT 1ST AND 2ND LEVELS WITH THE C WEIGHTS USED IN THE ANALYSIS, WHICH C BECOME QUAL1 AND QUAL2, RESPECTIVELY, C BELOW. C 2 = IF 2ND LEVEL NOT THERE, DON'T USE C 1ST LEVEL FOR LAND STATIONS. FOR C TYPES 0-6, FALL BACK TO 1. C THE 3RD LEVEL IS TREATED AS A BACKUP FOR C THE 2ND LEVEL. C MESHB = BASE MESH LENGTH IN KM. (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 NXL = THE GRID EXTENT IN THE X DIRECTION AT MESH C LENGTH MESHB. (INPUT) C NYL = THE GRID EXTENT IN THE Y DIRECTION AT MESH C LENGTH MESHB. (INPUT) C R = THE LARGEST RADIUS AT THE PREFERRED FIRST C GUESS OPTION. (INPUT) C RSTAR = THE FACTOR TO MULTIPLY R BY TO GET THE X AND C Y LIMITS FOR THE DATA. (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). (INPUT/OUTPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ). C SECOND DIMENSION OF LSTORE( , ). (INPUT) C LITEMS = THE NUMBER OF ITEMS J IN LSTORE( ,L). C (INPUT/OUTPUT) 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 DATA(J) = WORK ARRAY FOR GFETCH (J=1,ND5) AND COMPUTATIONS. C (INTERNAL) C ND5 = DIMENSION OF IPACK( ), WORK( ), 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 IS C THE SPACE USED FOR THE MOS-2000 INTERNAL RANDOM C 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 = INCREMENTED EACH TIME DATA ARE FETCHED BY C GFETCH. IT IS A RUNNING COUNT FROM THE C BEGINNING OF THE PROGRAM. THIS COUNT C IS MAINTAINED IN CASE THE USER NEEDS IT C (DIAGNOSTICS, ETC.). (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 103 = COULD NOT IDENTIFY ID IN INTERNAL TABLE. C 666 = COUNTED AS A MINOR ERROR. C 777 = A VARIETY OF FATAL ERRORS. C OTHER VALUES FROM CALLED ROUTNES. EVERY C ERROR IS FATAL FOR THIS ROUTINE. C (OUTPUT) C NSLAB = SLAB OF THE GRID CHARACTERISTICS. RETURNED C BY GFETCH. USED FOR CHECKING FOR EQUAL C CHARACTERISTICS OF GRIDS READ. (INTERNAL) C ITABLE(J,L) = HOLDS THE 4-WORD IDS (J=1,4) OF THE IDCAT C VARIABLES TO WHICH THIS ROUTINE APPLIES C AND THE DATA TO ACCESS (L=1,IDCAT*10). C THE IDS ARE ARRANGED C (1) BASE VARIABLE, C (2) FIRST AUGMENTATION C (3) 2ND AUGMENTATION, C (4) 3RD AUGMENTATION, C (5) 4TH AUGMENTATION, C (6-9) OPEN SLOTS, C (10) THE VARIABLE TO READ FOR PAST TOSSES. C (INTERNAL) C TRATIO = THE FRACTION OF THE WAY BETWEEN 3-HOURLY GRIDS C TO GET THE PROJECTION NEEDED, WHEN TIME C INTERPOLATION IS NEEDED. WILL BE 0, 1/3, OR C 2/3. (INTERNAL) C JDATE = THE DATE TIME TO LOOK FOR AUGMENTATION DATA. C (INTERNAL) C JTAU1 = THE FIRST PROJECTION AUXILIARY DATA ARE NEEDED. C (INTERNAL) C JTAU2 = THE SECOND PROJECTION AUXILIARY DATA ARE NEEDED. C (INTERNAL) C KDATE = SET TO MDATE, POSSIBLY MODIFIED. (INTERNAL) C DATA1(J) = WORK ARRAY FOR GFETCH (J=1,ND5) AND COMPUTATIONS. C (AUTOMATIC) (INTERNAL) C MAXSTA = THE MAXIMUM NUMBER OF NEIGHBORS (AUGMENTING C STATIONS) PROVIDED ON THE FILE WITH UNIT NUMBER C KFILAU. (INTERNAL) C LIST(K) = THE LOCATION IN THE STATION LIST (K=1,NSTA) OF C THE SAME STATION IN THE AUGMENTING LIST. C (INTERNAL) C LISTD(KK) = THIS LOCATION IN THE CCALLD( ) LIST OF THE C STATION IN THE CCALL( ) LIST (K=1,NSTA). C (INTERNAL) C TEMP(K,LL,NN) = TEMPORARY ARRAY FOR AUGMENTING XDATA( ) (LL=1,4) C (NN=1,2) (K=1,NSTA). THE FOUR VALUES OF LL ARE C FOR VALUES FROM THE 1ST, 2ND, 3RD, AND 4TH C LEVELS OF AUGMENTATION, RESPECTIVELY. NN=1 C FOR AUGMENTATION 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 CCALLD(M) = THE AUGMENTING STATION CALL LETTERS (M=1,MSTA). C (INTERNAL) C NOALOC(M) = THE NUMBER OF AUGMENTING STATIONS FOR STATION M C (M=1,MSTA). (INTERNAL) C IALOC(M,L) = THE POSITIONS OF THE AUGMENTING STATIONS C (L=1,MAXSTA) IN THE AUGMENTING LIST (M=1,MSTA). C (INTERNAL) C RDIST(M,L) = THE DISTANCES OF THE AUGMENTING STATIONS C (L=1,MAXSTA) IN THE AUGMENTING LIST FROM THE C STATION BEING AUGMENTED. (M=1,MSTA). (INTERNAL) C MSTA = THE NUMBER OF STATIONS THAT HAVE A LIST. C (INTERNAL) C IFIRST = CONTROLS PRINTING AND SPACING OF DIAGNOSTICS AT C 194, 195, 196, AND 2001. (INTERNAL) C JFIRST = CONTROLS PRINTING AND SPACING OF DIAGNOSTICS AT C 2185, ETC. (INTERNAL) C IREPL(NN) = 1 WHEN A STATION IS TO BE USED (NN=1); 1 WHEN A C STATION IS USED IF THERE CAN BE NO ADJUSTMENT C (NN=2) (NN=1,2). (INTERNAL) C MAXTAB(M,N,I) = THE MINIMUM (M=1) AND MAXIMUM (J=2) TEMP AND C DEWPOINT PROJECTIONS TO AUGMENT BY THE MAX C TEMP FOR THE FOUR ANALYSIS AREAS (N=1,4) FOR C TWO CYCLES (I=1 FOR 00Z; I=2 FOR 12Z). C (INTERNAL) C ICOR = 0 WHEN EITHER + OR - DELTA WILL BE APPLIED; C 1 WHEN ONLY + DELTA WILL BE APPLIED (REFERS TO C AUGMENTATION OF TEMPERATURE OR DEW POINT BY C MINIMUM TEMPERATURE); AND C 2 WHEN ONLY - DELTA WILL BE APPLIED (REFERS TO C AUGMENTATION OF TEMPERATURE OR DEW POINT BY C MAXIMUM TEMPERATURE). C (INTERNAL) C TMONTH(M,L) = THE FRACTIONAL WEIGHTS FOR EACH MONTH C (M=1,14) WHERE DECEMBER IS REPEATED AT THE C BEGINNING (M=1) AND JANUARY IS REPEATED AT C THE END (M=14) TO FACILITATE INTERPOLATION TO C THE DAY OF THE MONTH (L=1,IDCAT). USED ONLY C WITH LAMP AUGMENTATION WITH OBS. (INTERNAL) C THOUR(M,L) = THE FRACTIONAL WEIGHTS FOR EACH CYCLE HOUR C (M=1,24), WHERE M=1 FOR 0 HOUR (L=1,IDCAT). C USED ONLY WITH LAMP AUGMENTATION WITH OBS. C (INTERNAL) C TPROJ(M,L) = THE FRACTIONAL WEIGHTS FOR EACH PROJECTION UP C TO 38 HOURS FOR THE 2ND LEVEL OF AUGMENTATION C (M=1,25) (L=1,IDCAT). MAY BE USED ONLY C WITH LAMP AUGMENTATION WITH OBS. (INTERNAL) C ISPACE = CONTROLS SPACING BETWEEN #### DIAGNOSTICS. C (INTERNAL) C JBACK = NUMBER OF HOURS TO GO BACK IF AUGMENTING DATA C NOT FOUND. FOR MOS, THIS IS 6 HOURS; FOR OBS, C THIS IS 1 HOUR. (INTERNAL) C JONE = 0 IF A FIRST LEVEL OF AUGMENTATION IS NOT TO C BE DONE OR HAS NOT YET BEEN DONE; C 1 IF THE FIRST LEVEL OF AUGMENTATION IS TO BE C DONE; C 2 IF THE FIRST LEVEL OF AUGMENTATION WAS DONE C SUCCESSFULLY; C 3 IF A FIRST LEVEL WAS ATTEMPTED AND FAILED. C (INTERNAL) C JTWO = 0 IF A SECOND LEVEL OF AUGMENTATION IS NOT TO C BE DONE OR HAS NOT YET BEEN DONE; C 1 IF THE SECOND LEVEL OF AUGMENTATION IS TO BE C DONE; C 2 IF THE SECOND LEVEL OF AUGMENTATION WAS DONE C SUCCESSFULLY; C 3 IF A SECOND LEVEL WAS ATTEMPTED AND FAILED; C 4 (FOR LAMP ONLY) WHEN THERE ARE TOO FEW C AUGMENTATION VALUES TO USE MOS WITH ITS C USUAL WEIGHT. USE 1 INSTEAD FOR QUAL1. C (INTERNAL) C JTHREE = 0 IF A THIRD LEVEL OF AUGMENTATION IS NOT TO C BE DONE OR HAS NOT YET BEEN DONE; C 1 IF THE THIRD LEVEL OF AUGMENTATION IS TO BE C DONE; C 2 IF THE THIRD LEVEL OF AUGMENTATION WAS DONE C SUCCESSFULLY; C 3 IF A THIRD LEVEL WAS ATTEMPTED AND FAILED. C (INTERNAL) C KTLLB(N,M) = COUNTS OF DATA ACTUALLY USED IN THE ANALYSIS C AS AN AUGMENTING VALUE (N=1,5) (M=1,6). C N REPRESENTS THE 4 TYPES OF DATA C OCEAN, LAKE, LAKE OR LAND, AND LAND IN C THAT ORDER, THEN THE TOTAL AT AT N = 5. C M IS THE LEVEL OF AUGMENTATION FOR M=1,4, THEN C AT M = 5 IS THE INCOMING BASE STATIONS, AND C THEN THE TOTALS AT M=6. (INTERNAL) C KTAVG(N,M) = COUNTS THE DATA THAT WERE USED IN AVERAGING. C KTLLB( , ) COUNTS DATA NOT AVAILABLE IN A C PREVIOUS AUGMENTATION PASS (N=1,5) (M=1,6). C KTAVG( , ) COUNTS THE DATA POINTS THAT ARE C DUPLICATES. N REPRESENTS THE 4 TYPES OF DATA, C AND M THE AUGMENTATION PASS NUMBER. USED FOR C DIAGNOSTIC OUTPUT. (INTERNAL) C IDCAT = THE NUMBER OF VARIABLES ACCOMMODATED. C (PARAMETER) (INTERNAL) C DIAG(K,L) = FOR DIAGNOSTIC PRINTING (K=1,NSTA), XDATA( ) C AS INPUT (L=1), THE THREE POSSIBLE AUGMENTATION C VALUES FOR L=2,3,4,AND 5 CORRESPOIDING TO LEVELS C LL = 1,2,3,4. (INTERNAL) (AUTOMATIC) C IBTAG1(K) = HOLDS THE LTAG VALUES FROM OBS SPEED OR C TEMPERATURE ANALYSIS. (ALLOCATED) (INTERNAL) C IBTAG2(K) = HOLDS THE LTAG VALUES FROM OBS TOTAL WIND OR C DEWPOINT ANALYSIS. (ALLOCATED) (INTERNAL) C IOBFIR = 0 TO CAUSE IBTAG1( ) AND IBTAG2 TO GET C ALLOCATED, AND 1 TO KEEP IT FROM HAPPENING C AGAIN. (INTERNAL) C KER = 1 WHEN AUGMTO DID NOT EXECUTE PROPERLY; C 0 OTHERWISE. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GFETCH, TIMPR, UPDAT, AUGMTO C PARAMETER (IDCAT=24) C CHARACTER*4 STATE CHARACTER*8 CCALL(ND1),TRASH CHARACTER*8, ALLOCATABLE, DIMENSION(:) :: CCALLD CHARACTER*32 PLAIN CHARACTER*20 NAME(ND1) CHARACTER*60 FLAUG,FILEID,SAVFL,SAVID C DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION XDATA(ND1),LNDSEA(ND1),QUALST(ND1), 1 LTAGPT(ND1),MTAGPT(ND1),SDATA(ND1),XPL(ND1),YPL(ND1), 2 STALAT(ND1),STALON(ND1),NTAGPT(ND1),LTAG(ND1) DIMENSION DATA1(ND5) C DATA1( ) IS AN AUTOMATIC ARRAY. DIMENSION DIAG(NSTA,5) C DIAG( , ) IS AN AUTOMATIC ARRAY. DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION ISTOP(3),ITABLE(4,IDCAT*10),MAXTAB(2,4,2),LD(4), 1 KTLLB(5,6),IREPL(2),KTAVG(5,6) DIMENSION TMONTH(14,IDCAT),THOUR(24,IDCAT),TPROJ(38,IDCAT) C DIMENSION TMONTH(14,IDCAT),THOUR(24,IDCAT),TPROJ(38,23) C ALLOCATABLE NOALOC(:),IALOC(:,:),RDIST(:,:),LIST(:), 1 LISTD(:),TEMP(:,:,:),IBTAG1(:),IBTAG2(:) C CCALLD( ) IS ALLOCATABLE ABOVE. C DATA SAVFL/'TRASH'/, 1 SAVID/' '/ DATA IOBFIR/0/ C C NOTE: ADDITIONS TO THE ITABLE( , ) BELOW SHOULD BE AT C THE END BECAUSE SOME TESTS ASSUME THE ORDER HERE. C DATA ITABLE/222030035,0,0,0, 202020008, 0, 0, 0, !MOS TEMP X 702000000, 0, 0, 0, !OBS TEMP X 702000000, 0, 0, 0, !OBS TEMP X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 202030035, 970000, 0, 0, !OBS TEMP TOSSED X 702030085, 940000, 0, 0, !OBS TEMP TOSSED C 1 223030035,0,0,0, 203020008, 0, 0, 0, !MOS TD X 703100000, 0, 0, 0, !OBS TD X 703100000, 0, 0, 0, !OBS TD X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 203030035, 970000, 0, 0, !LAMP TD TOSSED X 202030035, 970000, 0, 0, !LAMP TEMP TOSSED X 703130085, 940000, 0, 0, !OBS TD TOSSED C 2 224335035,0,0,0, 204335008, 0, 0, 0, !MOS WIND SPEED X 704330000, 0, 0, 0, !OBS WIND SPEED X 704330000, 0, 0, 0, !OBS WIND SPEED X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 204335035, 970000, 0, 0, !LAMP SPEED TOSSED X 704330085, 940000, 0, 0, !OBS SPEED TOSSED C 3 224020035,0,0,0, 204020008, 0, 0, 0, !MOS U-WIND X 704020000, 0, 0, 0, !OBS U-WIND X 704020000, 0, 0, 0, !OBS U-WIND X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 204335035, 970000, 0, 0, !LAMP SPEED TOSSED (PUT IT IN TWICE) X 204335035, 970000, 0, 0, !LAMP SPEED TOSSED C 4 224120035,0,0,0, 204120008, 0, 0, 0, !MOS V-WIND X 704120000, 0, 0, 0, !OBS V-WIND X 704120000, 0, 0, 0, !OBS V-WIND X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 204020035, 970000, 0, 0, !LAMP U-WIND TOSSED (PUT IT IN TWICE) X 204020035, 970000, 0, 0, !LAMP U-WIND TOSSED C THE ABOVE ACCOMMODATES FOR LAMP AUGMENTED FIRST WITH MOS C THEN WITH OBS IN ORDER: C 1 TEMPERATURE C 2 DEW POINT C 3 WIND SPEED C 4 U-WIND C 5 V-WIND 5 222020061,000000000,0,0, 202150008,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, 6 223020061,000000000,0,0, 202150008,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, 7 222120061,000000000,0,0, 202150008,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, 8 222220061,000000000,0,0, 202250008,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, C THE ABOVE ACCOMMODATES FOR ENSEMBLE MEANS AND C PROBABILITIES WITH MOS MAX/MIN, IN ORDER: C 6 TEMPERATURE C 7 DEW POINT C 8 MAX TEMP C 9 MIN TEMP 9 222020008,0,0,0, 202150008,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 202020008, 970000, 0, 0, !MOS TEMP, READ TEMP LTAG( ) -3 HR A 223020008,0,0,0, 202150008,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 0,0,0,0, X 202020008, 970000, 0, 0, !MOS DP, READ TEMP LTAG( ) X 203020008, 970000, 0, 0, !MOS DP, READ DP LTAG( ) -3H C THE ABOVE ACCOMMODATES FOR MOS WITH MOS MAX/MIN, C IN ORDER: C 10 TEMPERATURE C 11 DEW POINT C AUGMENTAION BY MAX/MIN HAS BEEN PULLED BECAUSE OF C MANY EXISTING MOS MESONET FORECASTS. IT CAN STILL C BE USED TO CARRY LTAGS FORWARD, TEMP TO DP. C*********************************************************** B 722030085,0,0,0, 702000000, 0,0,0, !ANALYSIS AND OBS FOR 1ST LEVEL X 202020008, 0,0,0, !MOS FOR 2ND LEVEL (WATER ONLY) X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, !WORD 5 NOT USED FOR TEMP C 723130085,0,0,0, 703100000, 0,0,0, X 203020008, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 0, 0,0,0, X 702030085, 970000,0,0, !READ LTAG FROM TEMPERATURE C THE ABOVE ACCOMMODATES FOR OBS AUGMENTED FIRST WITH C PREVIOUS HOUR OBS (LAND AND WATER) THEN WITH C MOS (WATER AND NORTH CANADA) IN ORDER: C 12 TEMPERATURE C 13 DEW POINT D 228080005,0,0,0, 008000074,0,0,200, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, E 228160005,0,0,0, 008100074,0,0,200, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, X 0,0,0, 0, C THE ABOVE ACCOMMODATES FOR LAMP WITH SREF, IN ORDER C (NOTE THESE VALUES ARE INTERPOLATED; ISG = 200) C (NO LONGER USED.) C 14 CEILING HEIGHT C 15 VISIBILITY F 724330085,0,0,0, 704330000, 0,0,000, !ANALYSIS AND OBS FOR 1ST LEVEL X 204335008, 0,0, 0, !MOS FOR 2ND LEVEL (WATER ONLY) X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, !WORD 5 NOT USED FOR SPEED G 724020085,0,0,0, 704020000, 0,0,000, X 204020008, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 704330085, 970000,0,000, !READ LTAG AROM OBS SPEED H 724120085,0,0,0, 704120000, 0,0,000, X 204120008, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 704020085, 970000,0,000, !READ LTAG FROM OBS U-WIND C THE ABOVE ACCOMMODATES FOR OBS AUGMENTED FIRST WITH C PREVIOUS HOUR OBS (LAND AND WATER) THEN WITH C MOS (WATER AND NORTH CANADA) IN ORDER: c 16 WIND SPEED C 17 U-WIND C 18 V-WIND I 724390085,0,0,0, 704331000, 0,0,000, !ANALYSIS AND ON TIME GUSTS FOR 1ST LEVEL X 204380008, 0,0, 0, !MOS GUSTS FOR 2RD LEVEL (CANADA AND WATR) PLOTTED ' X 704331000, 0,0, 0, !GUSTS ONE HOUR OLD FOR 3ND LEVEL PLOTTED " X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 0, 0,0, 0, X 704330085, 970000,0,000, !TOSSES FROM OBS SPEED C THE ABOVE ACCOMMODATES OBSERVED TOTAL WIND. THE BASE C DATA IS THE FULLY AUGMENTED WIND SPEED, SO IT HAS ON-TIME C OBS, 1-H OLD OBS, AND THEN MOS WIND OVER WATER AND NORTH C CANADA. THE AUGMENTATION HERE IS FIRST WITH ON HOUR GUSTS, C THEN MOS GUSTS OVER WATER AND NORTH CANADA, AND THEN C PREVIOUS HOUR GUSTS (LAND AND WATER): C 19 OBSERVED TOTAL WIND SPEED (WIND AND GUSTS) J 224390035,0,0,0, 204355005, 0,0,000, !LAMP TOTAL WIND AND LAMP GUSTS FOR 1ST LEVEL X 204380008, 0,0, 0, !MOS GUSTS FOR 2ND LEVEL PLOTTED ' X 704331000, 0,0, 0, !OBS 0-h GUSTS FOR 3RD LEVEL PLOTTED " X 704331000, 0,0, 0, !OBS -1-h GUSTS FOR 4TH LEVEL PLOTTED ^ X 0, 0,0, 0, X 0, 0,0, 0, X 224390035, 970000,0, 0, !TOSSES FOR LAMP TW (FG IS LAMP SPEED) X 204335035, 970000,0, 0, !TOSSES FOR LAMP SPEED X 724390085, 940000,0, 0, !TOSSES FOR OBS TW C THE ABOVE ACCOMMODATES LAMP TOTAL WIND. THE BASE C DATA IS THE FULLY AUGMENTED LAMP WIND SPEED, SO IT C HAS LAMP, MOS, ON-OBS, AND THEN 1-H OLD OBS. THE C AUGMENTATION HERE IS FIRST WITH FORECAST LAMP GUSTS, THEN C MOS GUSTS, THEN OBS 0-H, THEN OBS -1-H: C 20 LAMP TOTAL WIND SPEED (WIND AND GUSTS) C K 224360008,0,0,0, 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 204360008, 970000, 0, 0, !MOS S TOSSED PAST PROJECTION C L 224060008,0,0,0, 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, ! X 204360008, 970000, 0, 0, !MOS S TOSSED CURRENT CYCLE C M 224160008,0,0,0, 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, ! X 204060008, 970000, 0, 0, !MOS U-WIND CURRENT CYCLE C N 224385008,0,0,0, 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, ! X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, X 0, 0, 0, 0, ! X 204360008, 970000, 0, 0/ !MOS S TOSSED CURRENT CYCLE C THE ABOVE ACCOMMODATES MOS WIND SPEED, U, V, AND GUSTS C NO AUTMENTAION, BUT LINKS WITH PREVIOUS LTAGS. C 21 SPEED C 22 U-WIND C 23 V-WIND C 24 GUSTS C DATA MAXTAB/15,27, 1 18,30, 2 18,30, 3 12,24, C THE ABOVE ARE FOR THE 00Z CYCLE. 4 27,39, 5 30,42, 6 30,42, 7 24,36/ C THE ABOVE ARE FOR THE 12Z CYCLE. C C THESE ARE THE MONTHLY WEIGHTS GROUPED BY INPUT. C DATA TMONTH/14*1.,14*1.,14*1.,14*1.,14*1., 1 14*1.,14*1.,14*1.,14*1., 2 14*1.,14*1., 3 14*1.,14*1., 4 14*1.,14*1., 5 14*1.,14*1.,14*1., 6 14*1., 7 14*1., 8 14*1.,14*1.,14*1.,14*1./ C C THESE ARE THE HOURLY WEIGHTS GROUPED BY INPUT. C DATA THOUR /24*1.,24*1.,24*1.,24*1.,24*1., 1 24*1.,24*1.,24*1.,24*1., 2 24*1.,24*1., 3 24*1.,24*1., 4 24*1.,24*1., 5 24*1.,24*1.,24*1., 6 24*1., 7 24*1., 8 24*1.,24*1.,24*1.,24*1./ C C THESE ARE THE PROJECTION WEIGHTS GROUPED BY INPUT. C C 1 2 3 4 5 6 7 8 9 10-38 DATA TPROJ/.99,.95,.85,.6,.4,.2,.1,.05,.03,29*.01, 1 .99,.95,.85,.6,.4,.2,.1,.05,.03,29*.01, C THE ABOVE VALUES ARE FOR LAMP TEMP, DEW POINT. 2 .90,.75,.60,.40,.20,.10,32*.10, 3 .90,.75,.60,.40,.20,.10,32*.10, 4 .90,.75,.60,.40,.20,.10,32*.10, C THE ABOVE VALUES ARE FOR LAMP WIND S, U, AND V. 5 38*1.0,38*1.0,38*1.0,38*1.0, 6 38*1.0,38*1.0, 7 38*1.0,38*1.0, 8 38*1.0,38*1.0, 9 38*1.0,38*1.0,38*1.0, A 38*1.0, B .90,.75,.65,.50,.40,.20,.20,.10,30*.10, C THE ABOVE VALUES ARE FOR LAMP TOTAL WIND. C 38*1.0,38*1.0,38*1.0,38*1.0/ C THE ABOVE VALUES ARE FOR MOS S, U, V, AND G. C SAVE SAVFL,SAVID SAVE CCALLD,NOALOC,IALOC,RDIST,LIST,LISTD,TEMP C EVEN THOUGH THE CONTENTS OF TEMP( , , ) DO NOT NEED C TO BE SAVED, TO BE AVAILABLE UPON REENTRY, IT C SEEMS TEMP NEEDS TO BE IN SAVE STATEMENT. SAVE IALL SAVE IBTAG1,IBTAG2 C CALL TIMPR(KFILDO,KFILDO,'START AUGMT2 ') C IER=0 KER=0 NER=0 IFIRST=0 JFIRST=0 ISPACE=0 JBACK=6 C JBACK = 6 IS THE GENERIC MOS VALUE. FOR HOURLY C TEMPERATURE AUGMENTATION, IT IS SET TO 1 BELOW. IPREX5=NINT(PREX5) C C COMPUTE MINIMUM AND MAXIMUM IX AND JY TO AUGMENT C A STATION AND COUNT IT. C RMINXY=1.-R*RSTAR RMAXX=NXL+R*RSTAR RMAXY=NYL+R*RSTAR RLIMIT=R*RSTAR C CCCCC WRITE(KFILDO,101)MESHB,NXL,NYL,PREX3, CCCCC 1 R,RSTAR,RMINXY,RMAXX,RMAXY,ND10,L3264B CCCCC 101 FORMAT(/' IN AUGMT2--MESHB,NXL,NYL,PREX3,', CCCCC 1 'R,RSTAR,RMINXY,RMAXX,RMAXY,ND10,L3264B',/, CCCCC 2 ' ',3I5,6F7.1,2I10) CCCCC WRITE(KFILDO,1010)IOBS,IPREX1,IPREX2,PREX3,PREX5,NUMAUG,IBACK CCCCC 1010 FORMAT(/' IN AUGMT2--IOBS,IPREX1,IPREX2,PREX3,PREX5,NUMAUG,IBACK', CCCCC 1 3I5,2F5.2,2I4) C C CHECK LEGITIMACY OF MONTH. IF THIS IS NOT CORRECT, C TMONTH( , ) MAY GO OUT OF BOUNDS. C IF(MONTH.LT.1.OR.MONTH.GT.12)THEN WRITE(KFILDO,1013)MONTH 1013 FORMAT(/' ****MONTH =',I6,' NOT IN RANGE 1 TO 12.', 1 ' FATAL ERROR. ABORT AUGMT2.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C C CHECK LEGITIMACY OF ICYCLE. IF THIS IS NOT CORRECT, C THOUR( , ) MAY GO OUT OF BOUNDS. C IF(ICYCLE.LT.0.OR.ICYCLE.GT.23)THEN WRITE(KFILDO,1014)ICYCLE 1014 FORMAT(/' ****ICYCLE =',I6,' NOT IN RANGE 0 TO 23.', 1 ' FATAL ERROR. ABORT AUGMT2.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C C INITIALIZE KTLLB( , ) AND KTAVG( , ) TO ZERO. C DO 1016 LL=1,6 DO 1015 M=1,5 KTLLB(M,LL)=0 KTAVG(M,LL)=0 1015 CONTINUE 1016 CONTINUE C C INITIALIZE LTAGPT( ), NTAGPT( ) AND DIAG( , ) TO ZERO. C NOTE THAT MTAGPT( ) IS NOT ZEROED. FOR TW IT COMES C IN FROM WIND SPEED. C DO 1017 K=1,NSTA LTAGPT(K)=0 NTAGPT(K)=0 DIAG(K,1)=XDATA(K) DIAG(K,2)=9999. DIAG(K,3)=9999. DIAG(K,4)=9999. DIAG(K,5)=9999. C BASE DATA IN XDATA( ) COME IN THROUGH THE CALL. C THIS SAVES XDATA( ) FOR SIDE BY SIDE PRINTING. 1017 CONTINUE C C COUNT THE NUMBER OF GOOD BASE DATA IN 4 STATION C TYPE CATEGORIES. C DO 102 K=1,NSTA C IF(XDATA(K).LT.9998.5)THEN C IF(XPL(K).GE.RMINXY.AND.YPL(K).GE.RMINXY.AND. 1 XPL(K).LE.RMAXX.AND.YPL(K).LE.RMAXY)THEN C KT=LNDSEA(K)/3+1 C IF(KT.GE.1.AND.KT.LE.4)THEN KTLLB(KT,5)=KTLLB(KT,5)+1 C THIS IS THE COUNT OF BASE STATIONS. ELSE WRITE(KFILDO,1018)CCALL(K),NAME(K),LNDSEA(K) 1018 FORMAT(/' ****STATION ',A8,2X,A20, 'HAS A DATA TYPE =', 1 I3,' OTHER THAN 0, 3, 6, OR 9.'/ 2 ' NOT COUNTED AS BASIC TYPE. CONTINUING.') ENDIF C ENDIF C ENDIF C 102 CONTINUE C C CHECK NUMBER OF AUGMENTATION LEVELS SPECIFIED BY NUMAUG. C IF(NUMAUG.LT.0.OR.NUMAUG.GT.4)THEN WRITE(KFILDO,1025)NUMAUG 1025 FORMAT(/' ****NUMBER OF AUGMENTATION LEVELS SPECIFIED =', 1 I4,' IS OUTSIDE 0 TO 4 PERMISSIBLE RANGE. ', 2 'COUNTED AS FATAL FOR AUGMENTATION.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C C DETERMINE WHETHER VARIABLE IS IN THE LIST. C THE TAU IS NOT IN THE TABLE TO MAKE IT GENERIC, BUT C IS IN ID(3). ALSO, THE DESIGNATION FOR ENSEMBLE MEAN C (LLLL=^3^^) OR PROBABILITIES XX (LLLL=^^XX) ARE C OMITTED. C DO 105 L=1,IDCAT M=(L-1)*10+1 C THIS DEFINES M. NOTE THAT ID(2) IS NOT CHECKED HERE. C C ITABLE( , ) CONSTRUCTION AND INDEXING IS FOR EASY C READING AND MODIFICATION. CCCC WRITE(KFILDO,104)((ITABLE(J,N),J=1,4),N=M,M+3) CCCC 104 FORMAT(/' AT 104 IN AUGMT2--((ITABLE(J,N),J=1,4),', CCCC 1 'N=M,M+3)',/,(4I11)) C IF(ID(1).EQ.ITABLE(1,M).AND. 1 (ID(3)/1000).EQ.(ITABLE(3,M)/1000).AND. 2 ID(4).EQ.ITABLE(4,M))THEN C ON FALL THROUGH, L HAD NOW BEEN DEFINED. GO TO 108 ENDIF C 105 CONTINUE C C DROP THROUGH HERE MEANS THE ID WAS NOT FOUND. C ISTOP(1)=ISTOP(1)+1 IER=103 WRITE(KFILDO,107)(ID(J),J=1,4),IER 107 FORMAT(/,' ****VARIABLE ',I9.9,I10.9,I10.9,I4.3,' NOT', 1 ' ACCOMMODATED IN SUBROUTINE AUGMT2. IER =',I3,/, 2 ' AUGMENTATION CANNOT BE DONE. PROCEEDING.') GO TO 900 C C AT THIS POINT, L = POSITION IN VARIABLE LIST, AND C M = HOW TO ACCESS. C C ALLOCATE OBTAG( ). IT IS NEEDED TO SAVE THE LATGS FROM C OBS ANALYSIS. 108 IF(IOBFIR.EQ.0)THEN C THIS MUST BE EXECUTED ONLY ONCE. ALLOCATE(IBTAG1(ND1),IBTAG2(ND1),STAT=IOS) C IF(IOS.EQ.1)THEN WRITE(KFILDO,1080) 1080 FORMAT(/' ****ALLOCATION OF IBTAG1( ) AND IBTAG2 FAILED', 1 ' IN AUGMT2 AT 1081. ARRAY ALREADY ALLOCATED.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 C ELSEIF(IOS.EQ.2)THEN WRITE(KFILDO,1081) 1081 FORMAT(/' ****ALLOCATION OF IBTAG1( ) AND IBTAG2 FAILED', 1 ' IN AUGMT2 AT 1081. ARRAY NOT ALLOCATED.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C IOBFIR=1 C DO 1082 K=1,NSTA IBTAG1(K)=0 IBTAG2(K)=0 1082 CONTINUE C ENDIF C C READ THE LTAG DATA INTO SDATA( ), IF NECESSARY. LOOP C WILL NOT EXECUTE WHEN IOBS = 0. NORMALLY, C FOR OBS, IOBS = 0 FOR S AND T; IOBS = 1 FOR U,V,TW, AND DP, C FOR LAMP, IOBS = 1 FOR S,U,V,T; IOBS = 2 FOR TW AND DP. C FOR MOS, IOBS = 1 FOR TEMP; IOBS = 2 FOR DP. C C DO 1099 LL=1,IOBS C LOOP WILL NOT EXECUTE WHEN IOBS = 0. CCCCC WRITE(KFILDO,8083)LL,IOBS CCCCC 8083 FORMAT(/' AT 8083--LL,OOBS',2I4) LLM=LL C IF(IDPARS(12).GT.1)THEN C IF(L.NE.10.AND.L.NE.11.AND.L.LT.21)THEN C BELOW IS FOR LAMP; EXCLUDE MOS T AND TD. C ALSO EXCLUDES WIND S, U, V, G. C IF(IOBS.EQ.2)THEN C C THE ID FOR THE PROJECTIONS > 1 IS DIFFERENT FROM THE ID C FOR PROJECTION 1. FOR PROJECTION 1, ACCESSING 940000 C PRIOR TO 970000, BUT ORDER SHOULDN'T MATTER. C IF(LL.EQ.1)THEN LLM=LL+2 ELSE LLM=LL ENDIF C ELSE LLM=LL+1 ENDIF C ENDIF C ENDIF C LD(1)=ITABLE(1,M+10-LLM) LD(2)=ITABLE(2,M+10-LLM) LD(3)=ITABLE(3,M+10-LLM)+IDPARS(12) C IF((L.LE.3.OR.L.EQ.20).AND.LL.EQ.1)THEN C THIS IS ONLY FOR THE FIRST ONE READ FOR LAMP C TEMPERATURE, DEWPOINT, AND TOTAL LIND. C IT DOES NOT APPLY TO U-WIND OR V-WIND. LD(3)=ID(3)-1 c ELSEIF(L.EQ.10.OR.L.EQ.21)THEN LD(3)=LD(3)-3 C THIS IS FOR MOS TEMPERATURE OR WIND SPEED. NEEDS C THE PREVIOUS PROJECTION, PRESUMABLY 3 HOURS AGO. C IF(IDPARS(12).LE.6)THEN GO TO 1099 C FOR PROJECTIONS LE 6, NO PREVIOUS FORECAST EXISTS. ELSEIF(IDPARS(12).GE.198)THEN LD(3)=LD(3)-3 C FOR PROJECTIONS GE 198, THE PREVIOUS FORECAST IS C 6 H PREVIOUS (ANOTHER 3). ENDIF C ELSEIF((L-1)*10+10+1-LLM.EQ.110)THEN LD(3)=LD(3)-3 C THIS IS FOR MOS DP. NEEDS THE PREVIOUS DP PROJECTION, C PRESUMABLY 3H AGO. CCCCC WRITE(KFILDO,7887)LL,IOBS,LLM,LD(3),IDPARS(12) CCCCC 7887 FORMAT(' AT 7887 IN AUGMT2--LL,IOBS,LLM,LD(3),IDPARS(12)', CCCCC 1 5I10) C IF(IDPARS(12).LE.6)THEN GO TO 1099 C FOR PROJECTIONS LE 6, NO PREVIOUS FORECAST EXISTS. ELSEIF(MOD(LD(3),1000).GE.195)THEN LD(3)=LD(3)-3 C FOR PROJECTIONS GE 198, THE PREVIOUS FORECAST IS C 6 H PREVIOUS (ANOTHER 3). ENDIF C ENDIF C LD(4)=ITABLE(4,M+10-LLM) C CCCCC WRITE(KFILDO,9082)IOBS,L,M,LL,LLM,ID,LD CCCCC 9082 FORMAT(' AT 9082--IOBS,L,M,LL,LLM,ID,LD',5I4,4X,4I11,/, CCCCC 1 ' ',20X,4X,4I11) C IF(LD(1).NE.0)THEN C LTAG( ) HAS BEEN SET TO ZERO IN U405A. CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,SDATA,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,1083)(LD(J),J=1,4),(ID(J),J=1,4) 1083 FORMAT(/,' ****COULDN''T FETCH DATA ',4I10, 1 ' FROM INTERNAL STORAGE IN AUGMT2.',/, 2 ' DATA ',4I10,' NOT CHECKED', 3 ' WITH TOSSED ANALYSIS DATA.') ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 IER=0 C IF(L.NE.10.AND.L.NE.11.AND.L.NE.21.AND.L.NE.22.AND. 1 L.NE.23.AND.L.NE.24)THEN KER=1 ENDIF C THIS IS COUNTED AS A MAJOR ERROR EXCEPT FOR MOS C (TEMP, DP, WIND S,U,V,G. IT IS LIKELY MOS FOR A C PARTICULAR PROJECTION ARE RUN TOGETHER, BUT C PROJECTIONS WILL BE SPLIT. IF THIS IS COUNTED C AS A MOJOR ERROR, EACH RESTART WILL TRIGGER IT. C PROGRAM WILL RUN WITHOUT PREVIOUS LTAG( ). C (ADDED 1/1/16) ELSE C CCCC DO 1084 K=1,NSTA CCCC LTAG(K)=NINT(SDATA(K)) CCCC WRITE(KFILDO,9083)K,CCALL(K),LTAG(K),SDATA(K) CCCC 9083 FORMAT(' AT 9083--K,CCALL(K),LTAG(K),SDATA(K)', CCCC 1 I6,2X,A8,I4,F8.1) CCCC 1084 CONTINUE C C SAVE THE LTAG VALUES IN IBTAG1( ) OR IBTAG2( ). C VALUES IN SDATA( ) ARE REAL BECAUSE THEY WERE C PACKED. CONVERT TO INTEGER. DO 1085 K=1,NSTA C IF(LTAG(K).EQ.0)THEN LTAG(K)=NINT(SDATA(K)) C IF(NUMAUG.EQ.0)THEN C SETTING LTAG( ) = -1 TO 4 HERE WHEN C NUMAUG = 0 TO CARRY MISSINGS FORWARD. C THIS IS NORMALLY DONE IN THE NUMAUG LOOP. C PUT IN 1-2-16 FOR MOS TEMP/DP. C IF(LTAG(K).EQ.-1)THEN LTAG(K)=4 ENDIF C ENDIF C ENDIF C 1085 CONTINUE C IF(IDPARS(12).EQ.1.AND.LL.EQ.1)THEN C IF(L.EQ.1.OR.L.EQ.3)THEN C THIS IS FOR LAMP TEMPERATURE AND WIND SPEED. THEY C ARE SAVED AT PROJECTION 1, COMING FROM OBS. C ANY OB TOSSED MUST STAY TOSSED. C IF(LD(2).NE.940000)THEN C THIS IS A SAFETY. SHOULD NOT HAPPEN. WRITE(KFILDO,9085) 9085 FORMAT(/' ****ERROR AT 9085 IN AUGMT2 WHEN SAVING', 1 ' TOSSED DATA FROM OBS. LD(2) NE 940000.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C DO 1086 K=1,NSTA IBTAG1(K)=NINT(SDATA(K)) 1086 CONTINUE C WRITE(KFILDO,1087) 1087 FORMAT(/' SAVING IBTAG1 AT 1087. THIS SHOULD HAPPEN', 1 ' ONLY ONCE PER VARIABLE.') C ELSEIF(L.EQ.2.OR.L.EQ.20)THEN C THIS IS FOR LAMP TEMPERATURE AND WIND SPEED. THEY C ARE SAVED AT PROJECTION 1, COMING FROM OBS. C ANY OB TOSSED MUST STAY TOSSED. C IF(LD(2).NE.940000)THEN C THIS IS A SAFETY. SHOULD NOT HAPPEN. WRITE(KFILDO,9086) 9086 FORMAT(/' ****ERROR AT 9086 IN AUGMT2 WHEN SAVING', 1 ' TOSSED DATA FROM OBS. LD(2) NE 940000.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C DO 1088 K=1,NSTA IBTAG2(K)=NINT(SDATA(K)) 1088 CONTINUE C WRITE(KFILDO,1089) 1089 FORMAT(/' SAVING IBTAG2 AT 1089. THIS SHOULD', 1 ' HAPPEN ONLY ONCE PER VARIABLE.') ENDIF C ENDIF C DO 109 K=1,NSTA C IF(LTAG(K).NE.-1.AND.LTAG(K).NE.4)THEN LTAG(K)=0 ENDIF C CCCC IF(LTAG(K).NE.0)WRITE(KFILDO,1090)CCALL(K),LTAG(K) CCCC 1090 FORMAT(' AT 1090 IN AUGMT2--CCALL(K),LTAG(K)',2X,A8,I4) 109 CONTINUE C ENDIF C ENDIF C 1099 CONTINUE C CCCC ICOUNT=0 C CCCC DO 914 K=1,NSTA C CCCC IF(LTAG(K).EQ.-1)THEN CCCC ICOUNT=ICOUNT+1 CCCC WRITE(KFILDO,913)CCALL(K),XDATA(K),ICOUNT CCCC 913 FORMAT(' AT 913 IN AUGMT2--STATION WITH LTAG( ) = -1 ', CCCC 1 'XDATA(K),ICOUNT ',A8,F8.1,I7) CCCC ENDIF C CCCC 914 CONTINUE C CCCC ICOUNT=0 C CCCC DO 918 K=1,NSTA C CCCC IF(LTAG(K).EQ.4)THEN CCCC ICOUNT=ICOUNT+1 C CCCC IF(ICOUNT.EQ.1)THEN CCCC WRITE(KFILDO,916) CCCC 916 FORMAT(' ') CCCC ENDIF C CCCC IF(LL.EQ.1)THEN CCCC WRITE(KFILDO,917)CCALL(K),XDATA(K),ICOUNT CCCC 917 FORMAT(' PREVIOUS TOSSES--STATION WITH LTAG( ) = +4 ', CCCC 1 'XDATA(K),ICOUNT ',A8,F8.1,I7) CCCC ENDIF CCCC ELSEIF(LTAG(K).NE.0)THEN CCCC ICOUNT=ICOUNT+1 CCCC WRITE(KFILDO,9170)CCALL(K),XDATA(K),ICOUNT CCCC 9170 FORMAT(' AT 9170 IN AUGMT2--STATION WITH LTAG( ) NE 0 ', CCCC 1 'XDATA(K),ICOUNT ',A8,F8.1,I7) CCCC ENDIF C CCCC 918 CONTINUE C C SET JONE, JTWO, AND JTHREE DEPENDING ON WHETHER OR NOT C THE CORRESPONDING LEVEL OF AUGMENTATION IS TO BE DONE. C NOT ALL COMBINATIONS OF NUMAUG AND ITABLE( , ) ARE C CHECKED, ONLY THE ONE MATCHING NUMAUG. C 110 IF(NUMAUG.EQ.0)THEN GO TO 900 ELSEIF(NUMAUG.EQ.1)THEN C IF(ITABLE(1,M+1).NE.0)THEN WRITE(KFILDO,1100)(ID(J),J=1,4) 1100 FORMAT(/' ONE LEVEL OF AUGMENTATION WILL', 1 ' BE DONE FOR VARIABLE ',I9.9,I10.9,I10.9,I4.3) JONE=1 JTWO=0 JTHREE=0 ELSE WRITE(KFILDO,1101)(ID(J),J=1,4) 1101 FORMAT(/' ****FIRST ENTRY IN ITABLE( , ) IN AUGMT2 IS 0.', 1 ' AUGMENTATION CANNOT BE DONE.',/, 2 ' FATAL ERROR FOR VARIABLE ', 3 I9.9,I10.9,I10.9,I4.3) ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C ELSEIF(NUMAUG.EQ.2)THEN C IF(ITABLE(1,M+2).NE.0)THEN WRITE(KFILDO,1104)(ID(J),J=1,4) 1104 FORMAT(/' TWO LEVELS OF AUGMENTATION WILL BE DONE', 1 ' FOR VARIABLE ',I9.9,I10.9,I10.9,I4.3) JONE=1 JTWO=1 JTHREE=0 ELSE WRITE(KFILDO,1105)(ID(J),J=1,4) 1105 FORMAT(/' ****ONE LEVEL OF AUGMENTATION WILL', 1 ' BE DONE FOR VARIABLE ',I9.9,I10.9,I10.9,I4.3,/ 2 ' PROBABLY AN ERROR. CHECK NUMAUG AND', 3 ' AUGMT2 ITABLE( , ).') ISTOP(1)=ISTOP(1)+1 JONE=1 JTWO=0 JTHREE=0 ENDIF C ELSEIF(NUMAUG.EQ.3)THEN C NUMAUG HAS TO BE 1, 2, OR 3, EXCEPT FOR LAMP TOTAL WIND. C IF(ITABLE(1,M+3).NE.0)THEN WRITE(KFILDO,1106)(ID(J),J=1,4) 1106 FORMAT(/' THREE LEVELS OF AUGMENTATION WILL BE DONE', 1 ' FOR VARIABLE ',I9.9,I10.9,I10.9,I4.3) JONE=1 JTWO=1 JTHREE=1 ELSE WRITE(KFILDO,1107)(ID(J),J=1,4) 1107 FORMAT(/' ****TWO LEVELS OF AUGMENTATION WILL BE DONE', 1 ' FOR VARIABLE ',I9.9,I10.9,I10.9,I4.3,/ 2 ' PROBABLY AN ERROR. CHECK NUMAUG AND', 3 ' AUGMT2 ITABLE( , ).') ISTOP(1)=ISTOP(1)+1 JONE=1 JTWO=1 JTHREE=0 ENDIF C ELSE IF(NUMAUG.EQ.4)THEN C IF(ITABLE(1,M+4).NE.0)THEN WRITE(KFILDO,1108)(ID(J),J=1,4) 1108 FORMAT(/' FOUR LEVELS OF AUGMENTATION WILL BE DONE', 1 ' FOR VARIABLE ',I9.9,I10.9,I10.9,I4.3) JONE=1 JTWO=1 JTHREE=1 C THE 4TH LEVEL IS A BACKUP TO 3. ELSE WRITE(KFILDO,9108) 9108 FORMAT(/' FOURTH LEVEL OF AUGMENTATION HAS NO ID.', 1 ' ABORT AUGMT2. UPDATE ITABLE IN AUGMT2.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C ENDIF C ENDIF C C MAKE SURE PROJECTION = IDPARS(12) IS LE 25 FOR LAMP. C IF(L.LE.5.OR.L.EQ.14.OR.L.EQ.15.OR.L.EQ.20)THEN C C APPLIES TO LAMP AUGMENTATION BY MOS OR OBS. C NOTE THE MONTH OFFSETS, BECAUSE THE SEQUENCE C STARTS WITH DECEMBER RATHER THAN JANUARY. C C CHECK LEGITIMACY OF PROJECTION FOR C LAMP AUGMENTATION WITH OBS. OTHERWISE, C TPROJ( , ) WILL BE OUT OF BOUNDS. C IF(IDPARS(12).GT.38)THEN WRITE(KFILDO,1109)IDPARS(12) 1109 FORMAT(/' ****PROJECTION IDPARS(12) =',I5, 1 'GT 25 AUGMENTING LAMP WITH OBS.', 2 ' FATAL ERROR. ABORT AUGMT2.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C ENDIF C C INTERPOLATE MONTHLY VALUE TO DAY. C F IS THE VALUE MONTHLY VALUE INTERPOLATED C TO DAY. 30 DAYS PER MONTH IS ACCURATE ENOUGH. C NOTE OFFSET; SERIES STARTS ON DECEMBER. C IF(IDAY.GE.15)THEN F1=(45.-IDAY)/30. F=F1*TMONTH(MONTH+1,L)+ 1 (1.-F1)*TMONTH(MONTH+2,L) ELSE F1=(IDAY+15.)/30. F=F1*TMONTH(MONTH+1,L)+ 1 (1.-F1)*TMONTH(MONTH,L) ENDIF C C COMPUTE THE 1ST LEVEL = QUAL1 AND 2ND LEVEL = QUAL2 WEIGHTS C SANS THE DICTIONARY VALUE. ONLY THE DICTIONARY VALUE C VARIES BY STATION. PREX1 CONTROLS LEVEL 1 WEIGHT. C LEVEL 3 IS TREATED AS BACKUP TO LEVEL 2 AND HAS THE SAME C WEIGHT AS LEVEL 2. C QUAL2=PREX3*F*THOUR(ICYCLE+1,L) C IF(L.LE.5.OR.L.EQ.14.OR.L.EQ.15.OR.L.EQ.20)THEN QUAL2=QUAL2*TPROJ(IDPARS(12),L) C TPROJ( , ) ONLY HAS 25 PROJECTIONS AND APPLIES C TO ONLY LAMP. ENDIF C C PREX3 IS PRIMARILY FOR CHECKOUT, AND IS USUALLY = 1. C IF(IPREX1.EQ.0)THEN QUAL1=1. C THIS IS THE FIRST LEVEL OF AUGMENTATION WHERE MOS IS ALWAYS C WEIGHTED UNITY WHEN IPREX1 = 0. ELSE QUAL1=1.-QUAL2 C THIS IS THE SAME AS C QUAL1=PREX3*F*THOUR(ICYCLE+1,L)*(1.-THOUR(ICYCLE+1,L)) C THIS IS THE SECOND LEVEL OF AUGMENTATION. WHERE PREX3 C INITIALLY APPLIED ONLY TO LEVEL 2, IT IS NOW CONFOUNDED C INTO LEVEL 1. ENDIF C C MAKE SURE THIS IS EITHER A MEAN OR PROBABILITY FORECAST C WHEN EKDMOS. C IF(IDPARS(4).GE.61.AND.IDPARS(4).LE.64)THEN C THESE DD VALUES BASED ON 3/28/12 DOCUMENT, AND REPRESENT C EKDMOS FOR NAFES, GEFS, CMCE, AND FNMOC, RESPECTIVELY. C IF((IDPARS(6)-(IDPARS(6)/1000)*1000).EQ.0)THEN ISTOP(1)=ISTOP(1)+1 IER=103 WRITE(KFILDO,1110)(ID(J),J=1,4),IER 1110 FORMAT(/' ****LLLL DOES NOT INDICATE EITHER A MEAN OR', 1 ' PROBABILITY FORECAST FOR EKDMOS VARIABLE ', 2 I9.9,I10.9,I10.9,I4.3,/, 3 ' IER =',I5,'. ABORT AUGMENTATION.', 4 ' PROCEEDING.') GO TO 900 ENDIF C ENDIF C C MAKE SURE MOS AND EKDMOS ARE AT 00 AND 12 CYCLES. C LAMP AND HOURLY DATA CAN BE AN ANY HOUR (CYCLE). C IF(L.GE.6.AND.L.LE.11)THEN C IF(ICYCLE.NE.00.AND.ICYCLE.NE.12)THEN WRITE(KFILDO,1112)ICYCLE 1112 FORMAT(/' ****ICYCLE =',I4,' NOT EQUAL TO 00 OR 12', 1 ' IN AUGMT2 FOR MOS. AUGMENTATION NOT DONE.') ISTOP(1)=ISTOP(1)+1 GO TO 900 ENDIF C ENDIF C WRITE(KFILDO,1113)(ID(J),J=1,4),PLAIN,MONTH,IDAY,NHRRUN,IBACK, 1 IPREX2,QUAL1,QUAL2,NUMAUG 1113 FORMAT(/' AUGMENTATION FOR ',3I10,I4,3X,A32,/ 1 ' MONTH ',I5,/ 2 ' DAY ',I5,/ 3 ' HOURS PRIOR TO RUN TIME ',I5,/ 4 ' CYCLES TO TRY ',I5,/ 5 ' NO. OF AUGMENTING STA ',I5,/ 6 ' WEIGHT ON 1ST AUGMENTATION ',F6.3,/ 7 ' WEIGHT ON 2ND AUGMENTATION ',F6.3/ 8 ' NUMBER OF AUG LEVELS DONE ',I5) IF(IPREX5.EQ.0)THEN WRITE(KFILDO,1114) 1114 FORMAT(' AVERAGE OF 1ST AND 2ND AUGMT NO') ELSEIF(IPREX5.EQ.1)THEN WRITE(KFILDO,1115) 1115 FORMAT(' AVERAGE OF 1ST AND 2ND AUGMT YES') ELSE WRITE(KFILDO,1116) 1116 FORMAT(' 1ST LEVEL USED ONLY IF 2ND IS THERE', 1 ' FOR LAND; OTHERWISE, AVERAGE 1ST AND 2ND', 2 ' LEVELS.') ENDIF C C DO UP TO FOUR LEVELS OF AUGMENTATION PROVIDED THE IDS ARE IN C ITABLE( , ). C DO 250 LL=1,NUMAUG C KDATE=MDATE C NOTE THAT IN THE KCYCLE LOOP BELOW, KDATE IS UPDATED AT THE C END OF THE LOOP IF NECESSARY. REINITIALIZE FOR EACH C AUGMENTATION. ICOR=0 C C SKIP LOOP IF THIS LEVEL OF AUGMENTATION IS NOT TO BE DONE. C IF(LL.EQ.1.AND.JONE.EQ.0)GO TO 125 IF(LL.EQ.2.AND.JTWO.EQ.0)GO TO 125 IF(LL.EQ.3.AND.JTHREE.EQ.0)GO TO 125 IF(LL.EQ.4.AND.JTHREE.EQ.0)GO TO 125 C THE ABOVE ARE SAFETY CHECKS. C C LOOK FOR UP TO IBACK RUN CYCLES OF FORECASTS AT 3- OR 6-H C INTERVALS. FOR IBACK = 3 AT A 6-HR INTERVAL, THIS WILL C GO BACK 18 HOURS WHETHER 6-H RUNS ARE THERE OR NOT. FOR C LAMP FORECASTS AUGMENTED BY SREF, THE INTERVAL IS C 3 HOURS, NOT 6. AUGMENTATION OF HOURLY DATA BY THE C PREVIOUS HOUR SHOULD HAVE IBACKN = IBACK = 0. C DO 120 KCYCLE=0,IBACK C IPRT=1 C IPRT CONTROLS PRINTING DIAGNOSTIC AT 116. C IF(L.LE.5.OR.L.EQ.20)THEN C C THIS IS FOR AUGMENTATION OF LAMP CONTINUOUS VARIABLES C (L = 1-5 AND 20) C SET THE IDS FOR THE MOS OR OBS. C LD(1)=ITABLE(1,M+LL) LD(2)=ITABLE(2,M+LL) LD(4)=ITABLE(4,M+LL) C IF((L.LE.5.AND.LL.EQ.1).OR.(L.EQ.20.AND.LL.EQ.2))THEN C THIS IS MOS AUGMENTATION FOR LAMP T, DP, C S, U, V, AND TW JBACK=6 C IF(MOD(ICYCLE,6)+KCYCLE*6.LT.3)THEN IPRT=0 C IPRT CONTROLS PRINTING DIAGNOSTIC AT 116. GO TO 116 C THIS ASSUMES AT LEAST 3 HOURS BETWEEN MOS AND C LAMP RUN TIMES ARE REQUIRED. THIS MEANS, FOR C INSTANCE, A MOS RUN OF 12Z MIGHT BE AVAILABLE C BY THE TIME THE LAMP 15Z LAMP RUN IS MADE C (ABOUT 15:45 FOR THE ANALYSIS). ENDIF C CALL UPDAT(KDATE,-MOD(ICYCLE,6),JDATE) C JDATE IS NOW THE MOS RUN (CYCLE) TIME. IFGTAU=IDPARS(12)+MOD(ICYCLE,6)+KCYCLE*6 C IFGTAU IS THE MOS PROJECTION TIME. C C THE ASSUMPTION IS MADE THAT MOS FORECASTS ARE C AVAILABLE EVERY 6 HOURS FOR PROJECTIONS EVERY C 3 HOURS STARTING AT PROJECTION 6 HOURS. C JTAU1=IFGTAU-MOD(IFGTAU,3) C IF(JTAU1.LT.6)THEN C MOS PROJECTION IS LT 6 HOURS. IPRT=0 C IPRT CONTROLS PRINTING DIAGNOSTIC AT 116. GO TO 116 ENDIF C TRATIO=MOD(IFGTAU,3)/3. C CCCD WRITE(KFILDO,1117)TRATIO CCCD1117 FORMAT(/' TRATIO =',F6.3) C IF(TRATIO.LT..0001)THEN JTAU2=999 ELSE JTAU2=JTAU1+3 ENDIF C LD(3)=ITABLE(3,M+LL)+NHRRUN+JTAU1 C THIS TAU INCLUDES THE MOS PROJECTION. ELSEIF((L.LE.5.AND.LL.EQ.2).OR.(L.EQ.20.AND.LL.EQ.3))THEN C THIS IS ON-TIME OBS AND NEEDS NO TAU. JDATE=KDATE JTAU1=0 JTAU2=999 JBACK=0 LD(3)=ITABLE(3,M+LL)+NHRRUN CCCC WRITE(KFILDO,1117)L,LL,NHRRUN,(LD(I),I=1,4) CCCC 1117 FORMAT(/' AT 1117--L,LL,NHRRUN,(LD(I),I=1,4)', CCCC 1 3I4,4I13) ELSEIF(L.EQ.20.AND.LL.EQ.1)THEN C THIS IS LAMP GUST FOR TOTAL WIND AND NEEDS TAU. JDATE=KDATE JTAU1=0 JTAU2=999 JBACK=0 LD(3)=ITABLE(3,M+LL)+NHRRUN+IDPARS(12) ELSEIF((L.LE.5.AND.LL.EQ.3).OR.(L.EQ.20.AND.LL.EQ.4))THEN C THIS IS ONE HOUR OLD OBS AND NEEDS NO TAU, BUT C DATE IS DECREMENTED BY 1. CALL UPDAT(KDATE,-1,JDATE) JTAU1=0 JTAU2=999 JBACK=0 LD(3)=ITABLE(3,M+LL)+NHRRUN ELSE WRITE(KFILDO,1118) 1118 FORMAT(/' ****ERROR IN AUGMT2 AT 1118. ABORT AUGMT2.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C ELSEIF(L.GE.6.AND.L.LE.11)THEN C C THIS IS FOR AUGMENTATION OF ENSEMBLE MEANS AND C PROBABILITIES (L = 6-9) OR MOS TEMP OR DEW POINT C (L = 10,11) BY MOS MAX/MIN FORECASTS. C NHR=KDATE-(KDATE/100)*100 C NHR IS THE HOUR OF THE RUN. IT IS EXPECTED THIS WILL BE C 0, 6, 12, OR 18 FOR MOS, BUT CAN BE ANY HOUR FOR LAMP. CALL UPDAT(KDATE,-MOD(NHR,6),JDATE) C JDATE IS THE DATE OF THE DATA NEEDED. C C IT IS ASSUMED THE MOS FORECASTS RUN TIMES ARE C ARE AVAILABLE AT 6-H INTERVALS AND THE PROJECTIONS C ARE AVAILABLE AT 3-H INTERVALS. USE THE CORRECT C PROJECTION IF IT IS AVAILABLE; IF NOT, USE LINEAR C INTERPOLATION IN TIME. C IFGTAU=IDPARS(12)+MOD(NHR,6)+KCYCLE*6 C IFGTAU IS THE PROJECTION OF THE MOS FORECASTS. C IF(MOD(IDPARS(12),3).EQ.0)THEN JTAU1=IFGTAU JTAU2=999 TRATIO=0 ELSE C MOS AND EKDMOS RUN NO OFTENER THAN AT 6-H CYCLES, C AND BOTH PRODUCE FORECASTS EVERY 3 HOURS, SO THIS C SHOULD PROBABLY NOT EXECUTE. JTAU1=IFGTAU-MOD(IFGTAU,3) JTAU2=JTAU1+3 TRATIO=MOD(IFGTAU,3)/3. WRITE(KFILDO,1119) 1119 FORMAT(/' ****UNEXPECTED INTERPOLATION AT 1171 IN', 1 ' AUGMT2. PROCEEDING.') ISTOP(1)=ISTOP(1)+1 ENDIF C C SET THE IDS FOR THE MOS FORECASTS. C LD(1)=ITABLE(1,M+LL) LD(2)=ITABLE(2,M+LL) LD(3)=ITABLE(3,M+LL)+JTAU1+NHRRUN LD(4)=ITABLE(4,M+LL) C ELSEIF(L.EQ.12.OR.L.EQ.13.OR.(L.GE.16.AND.L.LE.18))THEN C C THIS IS FOR HOURLY TEMPERATURE; DEWPOINT; AND WIND C SPEED, U, AND V DATA ANALYSIS, AUGMENTATION OF ON TIME C DATA 1) WITH DATA FROM PREVIOUS HOUR (THE PROJECTION C IS STILL ZERO, BUT THE DATE IS ONE HOUR PREVIOUS.) AND C 2) WITH MOS DATA OVER WATER. C LD(1)=ITABLE(1,M+LL) LD(2)=ITABLE(2,M+LL) LD(4)=ITABLE(4,M+LL) C IF(LL.EQ.1)THEN C THIS IS FOR 1-H OLD OBS. CALL UPDAT(KDATE,-LL,JDATE) JTAU1=0 JTAU2=999 JBACK=1 LD(3)=ITABLE(3,M+LL) ELSE C THIS IS FOR MOS. JBACK=6 C IF(MOD(ICYCLE,6)+KCYCLE*6.LT.3)THEN IPRT=0 C IPRT CONTROLS PRINTING DIAGNOSTIC AT 116. GO TO 116 C THIS ASSUMES AT LEAST 3 HOURS BETWEEN MOS AND C LAMP RUN TIMES ARE REQUIRED. THIS MEANS, FOR C INSTANCE, A MOS RUN OF 12Z MIGHT BE AVAILABLE C BY THE TIME THE LAMP 15Z LAMP RUN IS MADE C (ABOUT 15:45 FOR THE ANALYSIS). ENDIF C CALL UPDAT(KDATE,-MOD(ICYCLE,6),JDATE) C JDATE IS NOW THE MOS RUN (CYCLE) TIME. IFGTAU=IDPARS(12)+MOD(ICYCLE,6)+KCYCLE*6 C IFGTAU IS THE MOS PROJECTION TIME. C C THE ASSUMPTION IS MADE THAT MOS FORECASTS ARE C AVAILABLE EVERY 6 HOURS FOR PROJECTIONS EVERY C 3 HOURS STARTING AT PROJECTION 6 HOURS. C JTAU1=IFGTAU-MOD(IFGTAU,3) C IF(JTAU1.LT.6)THEN C MOS PROJECTION IS LT 6 HOURS. IPRT=0 C IPRT CONTROLS PRINTING DIAGNOSTIC AT 116. GO TO 116 ENDIF C TRATIO=MOD(IFGTAU,3)/3. C IF(TRATIO.LT..0001)THEN JTAU2=999 ELSE JTAU2=JTAU1+3 ENDIF C LD(3)=ITABLE(3,M+LL)+NHRRUN+JTAU1 C THIS TAU INCLUDES THE MOS PROJECTION. ENDIF C CCCC WRITE(KFILDO,9997)L,M,LL,KDATE,JDATE,(LD(III),III=1,4), CCCC 1 JTAU1,JTAU2,TRATIO,ICYCLE,KCYCLE,IFGTAU CCCC 9997 FORMAT(/' AT 1119 (9997)', CCCC 1 'L,M,LL,KDATE,JDATE,(LD(III),III=1,4)', CCCC 2 'JTAU1,JTAU2,TRATIO,ICYCLE,KCYCLE,IFGTAU',/ CCCC 3 3I4,2I13,4I10,2I6,F5.2,3I4) C ELSEIF(L.EQ.19)THEN C C THIS IS FOR HOURLY OBS TOTAL WIND. THE BASE DATA IS THE C FULLY AUGMENTED WIND SPEED, SO IT HAS ON-TIME OBS, 1-H C OLD OBS, AND MOS WIND OVER WATER AND CANADA. THE C AUGMENTATION HERE IS FIRST WITH ON HOUR GUSTS, THEN C WITH MOS GUSTS OVER WATER AND CANADA, THEN PREVIOUS C HOUR GUSTS (LAND AND WATER). C LD(1)=ITABLE(1,M+LL) LD(2)=ITABLE(2,M+LL) LD(3)=ITABLE(3,M+LL) LD(4)=ITABLE(4,M+LL) JTAU1=0 JTAU2=999 JBACK=1 JDATE=KDATE C IF(LL.EQ.3)THEN C THIS IS FOR 1-H OLD OBS. CALL UPDAT(KDATE,-1,JDATE) C JDATE IS NOW THE PREVIOUS HOUR FOR GUSTS 1-H OLD ELSEIF(LL.EQ.2)THEN C THIS IS FOR MOS. CALL UPDAT(KDATE,-MOD(ICYCLE,6),JDATE) C JDATE IS NOW THE MOS RUN (CYCLE) TIME. IFGTAU=IDPARS(12)+MOD(ICYCLE,6)+KCYCLE*6 C IFGTAU IS THE MOS PROJECTION TIME. C C THE ASSUMPTION IS MADE THAT MOS FORECASTS ARE C AVAILABLE EVERY 6 HOURS FOR PROJECTIONS EVERY C 3 HOURS STARTING AT PROJECTION 6 HOURS. C JBACK=6 JTAU1=IFGTAU-MOD(IFGTAU,3) C IF(JTAU1.LT.6)THEN C MOS PROJECTION IS LT 6 HOURS. IPRT=0 C IPRT CONTROLS PRINTING DIAGNOSTIC AT 116. GO TO 116 ENDIF C TRATIO=MOD(IFGTAU,3)/3. C IF(TRATIO.LT..0001)THEN JTAU2=999 ELSE JTAU2=JTAU1+3 ENDIF C LD(3)=ITABLE(3,M+LL)+NHRRUN+JTAU1 C THIS TAU INCLUDES THE MOS PROJECTION. ENDIF C ELSEIF(L.EQ.14.OR.L.EQ.15)THEN C C THIS IS FOR AUGMENTATION OF LAMP CEILING AND VISIBILITY C (L = 14, 15) BY CURRENT AND PERHAPS PREVIOUS OBSERVATIONS. C JDATE=KDATE JTAU1=0 JTAU2=999 JBACK=1 C C SET THE IDS FOR THE OBS. C LD(1)=ITABLE(1,M+LL) LD(2)=ITABLE(2,M+LL) LD(3)=ITABLE(3,M+LL)+NHRRUN LD(4)=ITABLE(4,M+LL) C ENDIF C C SPECIAL ACCOMMODATION FOR MOS OR EKDMOS TEMP OR C DEWPOINT AUGMENTED BY MOS MAX OR MIN. C IF(L.EQ.10.OR.L.EQ.11.OR.L.EQ.6.OR.L.EQ.7)THEN ICC=ICYCLE/12+1 C IF(ICYCLE.EQ.0)THEN ITEST=IDPARS(12)-((IDPARS(12)-9)/24)*24 IF(ITEST.LT.MAXTAB(1,NAREA,ICC))ITEST=ITEST+24 C ABOVE ADDED 10/24/09 C C THIS LOOP HANDLES 00 GMT CYCLE. C IF(ITEST.GE.MAXTAB(1,NAREA,ICC).AND. 1 ITEST.LE.MAXTAB(2,NAREA,ICC))THEN IBASMX=(IDPARS(12)-9)/24 MMTAU=30+24*IBASMX+6*KCYCLE ICOR=2 C AUGMENT WITH MAX TEMP. C CCCD WRITE(KFILDO,112) CCCD 1 NAREA,ICYCLE,IDPARS(12), CCCD 2 MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX, CCCD 3 ITEST,MMTAU,KDATE,JDATE CCCD112 FORMAT(/' AT 112--', CCCD 1 'NAREA,ICYCLE,IDPARS(12),', CCCD 2 'MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX,', CCCD 3 'ITEST,MMTAU,KDATE,JDATE',/,8I5,2I12) C IF(IDPARS(12).LT.15.AND.KCYCLE.EQ.0)THEN C KCYCLE LETS IT DROP THE FIRST TIME, BUT NOT C STOP IT THEREAFTER. C IF(ISPACE.EQ.0)THEN WRITE(KFILDO,2175) ISPACE=1 ENDIF C WRITE(KFILDO,1122) 1122 FORMAT(' ####MAX TEMPERATURE DOES NOT EXIST', 1 ' FOR THIS PROJECTION FOR THIS CYCLE.') GO TO 116 ENDIF C ELSE IBASMX=(IDPARS(12)-6)/24 MMTAU=18+24*IBASMX+6*KCYCLE ICOR=1 C AUGMENT WITH MIN TEMP. MIN TEMP IS STORED C AT 24-H INCREMENTS STARTING AT TAU = 42 FOR THE C 0000 CYCLE AND AT TAU = 30 FOR THE 1200 CYCLE. C CCCD WRITE(KFILDO,1125) CCCD 1 NAREA,ICYCLE,IDPARS(12), CCCD 2 MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX, CCCD 3 ITEST,MMTAU,KDATE,JDATE CCCD1125 FORMAT(/' AT 1125--', CCCD 1 'NAREA,ICYCLE,IDPARS(12),', CCCD 2 'MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX,', CCCD 3 'ITEST,MMTAU,KDATE,JDATE',/,8I5,2I12) C IF(IDPARS(12).LT.15.AND.KCYCLE.EQ.0)THEN C KCYCLE LETS IT DROP THE FIRST TIME, BUT NOT C STOP IT THEREAFTER. C IF(ISPACE.EQ.0)THEN WRITE(KFILDO,2175) ISPACE=1 ENDIF C WRITE(KFILDO,1127) 1127 FORMAT(' ####MIN TEMPERATURE DOES NOT EXIST', 1 ' FOR THIS PROJECTION FOR THIS CYCLE.') GO TO 116 ENDIF C LD(1)=LD(1)+100000 C GET MIN TEMP RATHER THAN MAX TEMP. ENDIF C LD(3)=ITABLE(3,M+LL)+MMTAU+NHRRUN C ELSE C C THIS LOOP HANDLES 12 GMT CYCLE. C ITEST=IDPARS(12)-((IDPARS(12)-27)/24)*24 IF(ITEST.LT.MAXTAB(1,NAREA,ICC))ITEST=ITEST+24 C ABOVE ADDED 10/24/09 C IF(ITEST.GE.MAXTAB(1,NAREA,ICC).AND. 1 ITEST.LE.MAXTAB(2,NAREA,ICC))THEN IBASMX=(IDPARS(12)-3)/24 MMTAU=18+24*IBASMX+6*KCYCLE ICOR=2 C AUGMENT WITH MAX TEMP. C CCCD WRITE(KFILDO,113) CCCD 1 NAREA,ICYCLE,IDPARS(12), CCCD 2 MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX, CCCD 3 ITEST,MMTAU,KDATE,JDATE CCCD113 FORMAT(/' AT 113--', CCCD 1 'NAREA,ICYCLE,IDPARS(12),', CCCD 2 'MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX,', CCCD 3 'ITEST,MMTAU,KDATE,JDATE',/,8I5,2I12) C IF(IDPARS(12).LT.15.AND.KCYCLE.EQ.0)THEN C KCYCLE LETS IT DROP THE FIRST TIME, BUT NOT C STOP IT THEREAFTER. C IF(ISPACE.EQ.0)THEN WRITE(KFILDO,2175) ISPACE=1 ENDIF C WRITE(KFILDO,1132) 1132 FORMAT(' ####MAX TEMPERATURE DOES NOT EXIST', 1 ' FOR THIS PROJECTION FOR THIS CYCLE.') GO TO 116 ENDIF C ELSE IBASMX=(IDPARS(12)-6)/24 MMTAU=30+24*IBASMX+6*KCYCLE ICOR=1 C AUGMENT WITH MIN TEMP. MIN TEMP IS STORED C AT 24-H INCREMENTS STARTING AT TAU = 42 FOR THE C 0000 CYCLE AND AT TAU = 30 FOR THE 1200 CYCLE. C CCCD WRITE(KFILDO,1135) CCCD 1 NAREA,ICYCLE,IDPARS(12), CCCD 2 MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX, CCCD 3 ITEST,MMTAU,KDATE,JDATE CCCD1135 FORMAT(/' AT 1135--', CCCD 1 'NAREA,ICYCLE,IDPARS(12),', CCCD 2 'MAXTAB(1,NAREA,ICC),MAXTAB(2,NAREA,ICC),IBASMX,', CCCD 3 'ITEST,MMTAU,KDATE,JDATE',/,8I5,2I12) C IF(IDPARS(12).LT.15.AND.KCYCLE.EQ.0)THEN C KCYCLE LETS IT DROP THE FIRST TIME, BUT NOT C STOP IT THEREAFTER. C IF(ISPACE.EQ.0)THEN WRITE(KFILDO,2175) ISPACE=1 ENDIF C WRITE(KFILDO,1137) 1137 FORMAT(' ####MIN TEMPERATURE DOES NOT EXIST', 1 ' FOR THIS PROJECTION FOR THIS CYCLE.') GO TO 116 ENDIF C LD(1)=LD(1)+100000 C GET MIN TEMP RATHER THAN MAX TEMP. ENDIF C LD(3)=ITABLE(3,M+LL)+MMTAU+NHRRUN ENDIF C ENDIF C C OVERRIDE ICOR = 1 FOR MOS DEW POINT (L=11) AND EKDMOS C DEWPOINT (L=7). TEMPERATURE CAN ONLY GO UP FROM MIN, C BUT DEW POINT CAN GO UP OR DOWN. C IF((L.EQ.11.OR.L.EQ.7).AND.ICOR.EQ.1)THEN ICOR=0 ENDIF C CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,ND5, 2 NWORDS,NPACK,JDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) C IF(IER.NE.0)THEN ISTOP(3)=ISTOP(3)+1 GO TO 116 C IF THE RECORD IS NOT AVAILABLE, TRY ANOTHER RUN CYCLE. ENDIF C CCCC WRITE(KFILDO,1138)(LL,CCALL(K),DATA(K),K=1,NSTA) CCCC 1138 FORMAT(' AT 1138--(LL,CCALL(K),DATA(K),K=1,NSTA)'/ CCCC 1 (I10,4X,A8,F8.1)) C C AT THIS POINT, THE MOS FORECASTS FOR THE 1ST PROJECTION C NEEDED FOR (POSSIBLE) TIME INTERPOLATION HAS BEEN READ C INTO DATA( ). TRY FOR THE SECOND RECORD IF NEEDED C FOR INTERPOLATION. C IF(JTAU2.EQ.999)GO TO 125 C TRANSFER WHEN NO SECOND FIELD NECESSARY. c LD(3)=ITABLE(3,M+LL)+JTAU2+NHRRUN C CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA1,ND5, 2 NWORDS1,NPACK,JDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,LSLAB,MISSP,MISSS,L3264B,1,IER) C IF(IER.NE.0)THEN ISTOP(3)=ISTOP(3)+1 GO TO 116 C IF THE RECORD IS NOT AVAILABLE, TRY ANOTHER RUN CYCLE. ENDIF C IF(NWORDS.NE.NWORDS1)THEN ISTOP(1)=ISTOP(1)+1 WRITE(KFILDO,114) 114 FORMAT(/' ****NUMBER OF WORDS RETURNED FROM GFETCH NOT', 1 ' CONSISTENT IN AUGMT2 AT 114. TRY ANOTHER', 2 ' RUN CYCLE.') GO TO 116 ENDIF C C INTERPOLATE. C DO 115 K=1,NWORDS C IF(DATA(K).LT.9998.5.AND.DATA1(K).LT.9998.5)THEN DATA(K)=(DATA1(K)-DATA(K))*TRATIO+DATA(K) C FALLS THROUGH HERE WHEN ONE OR BOTH ARE MISSING. ELSE DATA(K)=9999. C BOTH 3-H VALUES MUST BE PRESENT BEFORE INTERPOLATION C CAN BE DONE. DATA( ) IS NOW THE AUGMENTING VALUE C AND CAN BE MISSING. ENDIF C 115 CONTINUE C GO TO 125 C C AT THIS POINT, THE AUXILIARY FORECASTS HAVE NOT BEEN C OBTAINED. TRY ANOTHER RUN CYCLE UNLESS KCYCLE.EQ.IBACK C OR JBACK = 0. WHEN THIS IS LAMP AND AUGMENTATION IS C WITH OBS, PREVIOUS CYCLES ARE NOT TO BE LOOKED FOR, C AND JBACK = 0. C 116 IF(KCYCLE.LT.IBACK.AND.JBACK.NE.0)THEN C IF(IPRT.EQ.1)THEN C IF(L.EQ.19)THEN C THIS IS OBS GUST. IF(LL.EQ.1)THEN C THIS IS ON-HOUR GUSTS. C TREAT AS FATAL. WRITE(KFILDO,1163) 1163 FORMAT(' ON-TIME GUSTS NOT', 1 ' AVAILABLE. FATAL ERROR.') IER=777 GO TO 125 ELSEIF(LL.EQ.2)THEN C THIS IS MOS GUSTS. GO BACK A CYCLE. WRITE(KFILDO,1164) 1164 FORMAT(' MOS GUSTS NOT AVAILABLE.', 1 ' TRY ANOTHER CYCLE.') GO TO 1175 ELSE C THIS IS 1-H OLD GUSTS. NOT FATAL. BUT C DON'T LOOK BACK ANOTHER CYCLE. (DATA C PROBABLY WOULDN'T BE AVAILABLE ANYWAY.) WRITE(KFILDO,1165) 1165 FORMAT(' 1-H OLD GUSTS NOT', 1 ' AVAILABLE. NON-FATAL ERROR.') IER=666 GO TO 125 ENDIF C ENDIF C WRITE(KFILDO,117)(LD(J),J=1,4),JDATE 117 FORMAT(' AUXILIARY FORECASTS ',3I10.9,I10.3, 1 ' UNAVAILABLE FOR DATE',I11, 2 ' TRYING ANOTHER DATE.') ENDIF C C PREPARE DATE/TIME. C 1175 CALL UPDAT(KDATE,-JBACK,KDATE) C THIS ASSUMES MOS IS AVAILABLE EVERY 6 HOURS. C HOURLY DATA AUGMENTATION WILL BE WITH PREVIOUS C HOUR, AND JBACK = 1. FOR HOURLY DATA, C IBACK MAY BE = 0. IER=0 C THIS IS FOR SAFETY. C ELSE WRITE(KFILDO,118)(LD(J),J=1,4),JDATE 118 FORMAT(/' ****AUXILIARY FORECASTS ',3I10.9,I10.3, 1 ' UNAVAILABLE FOR DATE',I11,'.',/, 2 ' CANNOT AUGMENT FORECASTS AT', 3 ' THIS LEVEL. THIS IS A MAJOR ERROR.') NER=1 C THIS IS A MAJOR ERROR. BUT OTHER LEVELS OF C AUGMENTATION CAN PROCEED. C IF(LL.EQ.1)THEN JONE=3 C JONE=3 MEANS 1ST LEVEL TRIED AND FAILED. C THEREFORE, 2ND LEVEL SHOULD REPLACE C STATIONS DESIGNATED LAND OR WATER. THIS C IS NECESSARY FOR GREAT SALT LAKE WHICH C HAS NO LAMP LAKE STATIONS. ELSEIF(LL.EQ.2)THEN JTWO=3 C JTWO=3 MEANS 2ND LEVEL TRIED AND FAILED. ELSE JTHREE=3 C JTHREE=3 MEANS 3RD LEVEL TRIED AND FAILED. ENDIF C IF(JBACK.EQ.0)GO TO 125 C FINISHED WITH THIS CYCLE ENDIF C 120 CONTINUE C 125 CONTINUE C C AT THIS POINT, THE AUGMENTING DATA FOR LEVEL LL ARE C IN DATA( ). ALSO, IBTAG1( ) CONTAINS THE LTAGS TO USE C FROM THE PREVIOUS ANALYSIS FOR TEMPERATURE AND SPEED, C AND IBTAG2( ) CONTAINS THE LTAGS TO USE FOR DEWPOINT C AND TOTAL WIND. FOR LAMP, WHENEVER IBTAG1( ) C = -1 OR = +4, SET THE CORRESPONDING OB MISSING SO C THAT IF MOS PLAYS IT WON'T BE AVERAGED WITH A BAD OB. C IF((LL.EQ.2.OR.LL.EQ.3).AND.(L.EQ.1.OR.L.EQ.3.OR. 1 L.EQ.4.OR.L.EQ.5))THEN C THE OBS NEED TO BE SET TO MISSING NOT ONLY FOR C LAMP TEMP AND SPEED, BUT ALSO U- AND V-WIND. ICOUNT=0 C DO 1252 K=1,NSTA C IF(IBTAG1(K).EQ.-1.OR.IBTAG1(K).EQ.4)THEN ICOUNT=ICOUNT+1 WRITE(KFILDO,1251)LL,CCALL(K),XDATA(K),IBTAG1(K),DATA(K), 1 ICOUNT 1251 FORMAT(' OBSERVATION SET TO MISSING AT 1251--', 1 'LL,CCALL(K),XDATA(K),IBTAG1(K),DATA(K),ICOUNT ', 2 I3,2X,A8,F7.1,I4,F7.1,I4) DATA(K)=9999. ENDIF C 1252 CONTINUE C ELSEIF(((LL.EQ.2.OR.LL.EQ.3).AND.L.EQ.2).OR. 1 ((LL.EQ.3.OR.LL.EQ.4).AND.L.EQ.20))THEN C LOOP ONLY FOR LAMP DEWPOINT AND TOTAL WIND. ICOUNT=0 C DO 1254 K=1,NSTA C IF(IBTAG2(K).EQ.-1.OR.IBTAG2(K).EQ.4)THEN ICOUNT=ICOUNT+1 WRITE(KFILDO,1253)LL,CCALL(K),XDATA(K),IBTAG2(K),DATA(K), 1 ICOUNT 1253 FORMAT(' OBSERVATION SET TO MISSING AT 1253--', 1 'LL,CCALL(K),XDATA(K),IBTAG2(K),DATA(K),ICOUNT ', 2 I3,2X,A8,F7.1,I4,F7.1,I4) DATA(K)=9999. ENDIF C 1254 CONTINUE C ENDIF C C AT THIS POINT, THE AUGMENTING DATA FOR LEVEL LL ARE C IN DATA( ) AND THE OBS TO NOT USE HAVE BEEN SET TO 9999. C C************************************* CCCC IF(LL.EQ.2)THEN CCCC WRITE(KFILDO,1255)(K,CCALL(K),XDATA(K),DATA(K),LTAG(K), CCCC 1 K=1,NSTA) CCCC 1255 FORMAT(/' AT 1255 IN AUGMT2'/ CCCC 1 ('K,CCALL(K),XDATA(K),DATA(K),LTAG(K)', CCCC 2 I10,2X,A8,2F7.1,I6)) CCCC ENDIF C************************************* C SAVE DATA( ) FOR LATER PRINTING. C DO 126 K=1,NSTA DIAG(K,LL+1)=DATA(K) 126 CONTINUE C C OPEN THE FILE AND READ THE PAIRS LIST. THE FIRST RECORD C IS AN IDENTIFICATION. READ IT IN ASCII AND RETAIN IT. C IF THE FILE NAME AND THE ID MATCH, THE DATA DO NOT C HAVE TO BE READ AND MATCHED WITH THE CURRENT LIST. C HOWEVER, THIS NEEDS TO BE DONE ONLY ONCE. NOTE THAT C UNSUCCESSFUL READING OF DATA FOR LL = 1 DOES NOT STOP C PROGRAM, AND IT STILL GOES THROUGH HERE. C C AUGMT2 NEEDS TO BE ENTERED FOR READING AND USING C PREVIOUS LTAGS, EVEN THOUGH AUGMENTATION IS NOT DONE. C PROVIDING A BLANK FILE WILL DO IT. C IF(FLAUG(1:6).EQ.' ')THEN WRITE(KFILDO,1265) 1265 FORMAT(/' AUGMT2 HAS A BLANK FILE NAME; NO AUGMENTATION', 1 ' IS DONE, BUT LTAG( ) WILL BE CARRIED IF NEEDED.') GO TO 900 ENDIF C IF(LL.GE.2)GO TO 2003 C NO NEED TO OPEN AND CHECK READING ON 2ND TIME THROUGH. C ALSO, CAN'T REINITIALIZE TEMP( , , ). C STATE='130 ' COPS OPEN(UNIT=KFILAU,FILE=FLAUG,STATUS='OLD', COPS 1 IOSTAT=IOS,ERR=127) OPEN(UNIT=KFILAU,STATUS='OLD',IOSTAT=IOS,ERR=127) GO TO 129 C 127 WRITE(KFILDO,128)FLAUG,KFILAU 128 FORMAT(/' ****AUGMENTATION FILE ',A60,' ON UNIT NO.',I4, 1 ' COULD NOT BE OPENED.'/' AUGMENTATION NOT DONE.') ISTOP(1)=ISTOP(1)+1 GO TO 900 C 129 WRITE(KFILDO,130)KFILAU,FLAUG 130 FORMAT(/,' OPENING PAIRS FILE ON UNIT NO.',I3, 1 ' FILE = ',A60) REWIND KFILAU STATE='132 ' READ(KFILAU,132,ERR=900)FILEID 132 FORMAT(A60) C IF(FILEID.EQ.SAVID.AND.FLAUG.EQ.SAVFL)THEN C THE FILE FOR AUXILIARY DATA IS THE SAME AS USED C PREVIOUSLY. C WRITE(KFILDO,133) 133 FORMAT(' THE FILE FOR AUXILIARY DATA IN AUGMT2', 1 ' IS THE SAME AS USED BEFORE.', 2 ' IT DOES NOT HAVE TO BE READ.') C IF(LL.EQ.1)THEN C INITIALIZE ALL FOUR COLUMNS OF TEMP( , , ). DO 135 J=1,4 DO 134 K=1,NSTA TEMP(K,J,1)=9999. TEMP(K,J,2)=9999. 134 CONTINUE 135 CONTINUE ENDIF C GO TO 2003 C THE TWO LISTS OF STATIONS ARE THE SAME, SO ALL C ARRAYS ARE THE SAME, EXCEPT TEMP( , , ) TO HOLD THE C DATA NEEDS TO BE INITIALIZED. ELSE D CALL TIMPR(KFILDO,KFILDO,'READING FILE ') SAVID(1:60)=FILEID(1:60) SAVFL(1:60)=FLAUG(1:60) WRITE(KFILDO,137)FILEID 137 FORMAT(' IDENTIFICATION ON THIS FILE IS: ',A60) C C READ THE NUMBER OF STATIONS AND MAXIMUM PAIRS. C STATE='138 ' READ(KFILAU,138,IOSTAT=IOS,ERR=910)MSTA,MAXSTA 138 FORMAT(2I6) WRITE(KFILDO,139)MAXSTA,MSTA,FLAUG 139 FORMAT(' UP TO',I3,' STATIONS IN EACH LIST FOR ', 1 I7,' STATIONS READ FROM FILE ',A60) C C IF THIS IS A DIFFERENT FILE, LIKELY MSTA OR MAXSTA C WILL BE DIFFERENT. DEALLOCATE AND REALLOCATE. C IT WON'T HURT IF THEY HAVE HAVEN'T BEEN ALLOCATED, C BUT THE ERROR STATUS IS CHECKED. C DEALLOCATE(CCALLD,NOALOC,IALOC,RDIST,LIST,LISTD,TEMP, 1 STAT=IOS) C IF(IOS.EQ.1.OR.IOS.EQ.3)THEN WRITE(KFILDO,1391)IOS 1391 FORMAT(/' ****ERROR DEALLOCATING VARIABLES.', 1 ' IOS =',I3,'. CONTINUING.') ISTOP(1)=ISTOP(1)+1 IER=777 D ELSE D WRITE(KFILDO,1392)IOS D1392 FORMAT(/' ****DEALLOCATED A VARIABLE WAS THAT WAS NOT', D 1 ' ALLOCATED. THIS WILL NOT AFFECT THE', D 2 ' RESULTS. IOS =',I4) ENDIF C IALL=MAX(NSTA,MSTA) C NOTE THAT MSTA CAN BE LARGER OR SMALLER THAN NSTA. C IF(IALL.GT.ND1)THEN WRITE(KFILDO,1395)MSTA,IALL,ND1 1395 FORMAT(/' ****MSTA =',I6,' AND IALL =',I6, 1 ' EXCEED ND1 =',I6, 'IN AUGMT2. ABORT.') GO TO 900 ENDIF C ALLOCATE(CCALLD(IALL),NOALOC(IALL),IALOC(IALL,MAXSTA), 1 RDIST(IALL,MAXSTA),LIST(IALL),LISTD(IALL), 2 TEMP(NSTA,4,2),STAT=IOS) C IF(IOS.EQ.1)THEN WRITE(KFILDO,140) 140 FORMAT(/' ****ALLOCATION OF ARRAYS FAILED IN AUGMT2 AT', 1 ' 140. ARRAY ALREADY ALLOCATED.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 C ELSEIF(IOS.EQ.2)THEN WRITE(KFILDO,141) 141 FORMAT(/' ****ALLOCATION OF ARRAYS FAILED IN AUGMT2 AT', 1 ' 141. ARRAY NOT ALLOCATED.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C C INITIALIZE LIST( ) AND LISTD( ). C DO 145 K=1,IALL LIST(K)=999999 LISTD(K)=999999 145 CONTINUE C C INITIALIZE ALL FOUR COLUMNS OF TEMP( , , ). C DO 148 J=1,4 DO 147 K=1,NSTA TEMP(K,J,1)=9999. TEMP(K,J,2)=9999. 147 CONTINUE 148 CONTINUE C C READ THE PAIRS. C DO 160 KK=1,MSTA STATE='150 ' READ(KFILAU,150,IOSTAT=IOS,ERR=910)CCALLD(KK),NOALOC(KK) 150 FORMAT(A8,I8) C CCC WRITE(KFILDO,151)KK,MSTA,CCALLD(KK),NOALOC(KK) CCC 151 FORMAT(' AT 151--KK,MSTA,CCALLD(KK),NOALOC(KK)',2I6,2X,A8,I6) C IF(NOALOC(KK).EQ.9999)GO TO 160 C NOALOC( ) = 9999 SIGNIFIES THERE IS NO LIST TO READ. C IALOC( , ) AND RDIST( ,) WILL BE UNDEFINED. C IF(NOALOC(KK).GT.MAXSTA)THEN WRITE(KFILDO,152)KK,NOALOC(KK),MAXSTA 152 FORMAT(/' ****NALOC(KK) =',I8,' GT MAXSTA =',I4, 1 ' FOR STATION NO. KK =',I6,' IN AUGMT2 AT 152.',/, 2 ' FATAL ERROR.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C STATE='155 ' READ(KFILAU,155,IOSTAT=IOS,ERR=910)(IALOC(KK,J),RDIST(KK,J), 1 J=1,NOALOC(KK)) 155 FORMAT(10(I6,F10.2)) C DO 1558 J=1,NOALOC(KK) C IF(IALOC(KK,J).GT.MSTA)THEN WRITE(KFILDO,1555)IALOC(KK,J),MSTA,CCALLD(KK) 1555 FORMAT(/,' ****LOCATION IN IALOC(KK,J) =',I9, 1 ' GREATER THAN SIZE OF LIST =',I6, 2 ' FOR STATION ',A8,/, 3 ' FATAL ERROR.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C 1558 CONTINUE C CCC WRITE(KFILDO,156)KK,(IALOC(KK,J),RDIST(KK,J),J=1,NOALOC(KK)) CCC 156 FORMAT(' AT 156 IN AUGMT2--KK,(IALOC(KK,J),RDIST(KK,J),', CCC 1 'J=1,NOALOC(KK))',I6,/,(I6,F10.2)) C 160 CONTINUE C C READ THE TERMINATOR. C STATE='162 ' READ(KFILAU,150,IOSTAT=IOS,ERR=910)TRASH C IF(TRASH.NE.'999999 ')THEN WRITE(KFILDO,165)TRASH 165 FORMAT(' ****DID NOT FIND TERMINATOR ON FILE IN AUGMT2.', 1 ' FOUND INSTEAD ',A8,/, 2 ' COUNT AS FATAL ERROR.') ISTOP(1)=ISTOP(1)+1 IER=777 GO TO 900 ENDIF C ENDIF C WRITE(KFILDO,167)NSTA,MSTA 167 FORMAT(/' THERE ARE',I6,' STATIONS BEING ANALYZED, AND',I6, 1 ' STATIONS FOR AUGMENTATION. SOME MAY HAVE MISSING', 2 ' DATA.') C C FIND THE LINKS FROM THE AUXILIARY MSTA LIST TO THE C PRIMARY NSTA LIST. C ISTART=1 IEND=MSTA C DO 200 K=1,NSTA C C FIND THE STATION IN CCALL(K) IN THE CCALLD(KK) LIST. C THEY OUGHT TO BOTH BE AT LEAST APPROXIMATELY IN ORDER, C AND STORE THE ORDER IN LIST( ). C 170 DO 190 KK=ISTART,IEND C IF(CCALLD(KK).EQ.CCALL(K))THEN LIST(K)=KK LISTD(KK)=K ISTART=KK C ISTART SET TO KK RATHER THAN KK+1 TO KEEP FROM INDEXING C PAST END OF ARRAY WHEN ISTART = IEND. IEND=MSTA GO TO 200 ENDIF C 190 CONTINUE C IF(ISTART.NE.1)THEN IEND=ISTART ISTART=1 GO TO 170 ENDIF C C DROP THROUGH HERE MEANS AUXILIARY STATION NOT FOUND. C IF(IFIRST.EQ.0)THEN WRITE(KFILDO,194) 194 FORMAT(' ') ISTOP(1)=ISTOP(1)+1 ENDIF C IF(IFIRST.LE.3)THEN WRITE(KFILDO,195)CCALL(K),NAME(K) 195 FORMAT(' ****STATION ',A8,A20,' NOT FOUND IN AUXILIARY LIST.', 1 ' PROCEEDING.') ENDIF C IF(IFIRST.EQ.4)THEN WRITE(KFILDO,196) 196 FORMAT(' THIS DIAGNOSTIC WILL NOT PRINT AGAIN.', 1 ' COUNTED AS ONE ISTOP ERROR.') ENDIF C LIST(K)=999999 ISTART=1 IEND=MSTA IFIRST=IFIRST+1 C 200 CONTINUE C IF(IFIRST.EQ.1)THEN WRITE(KFILDO,2001) 2001 FORMAT(' THERE WAS 1 ERROR OF THIS TYPE.') ELSEIF(IFIRST.NE.0)THEN WRITE(KFILDO,2002)IFIRST 2002 FORMAT(' THERE WERE',I6,' ERRORS OF THIS TYPE.') ENDIF C 2003 CONTINUE C CCCC DO 2005 K=1,MIN(IALL,ND1) CCCCC IALL COULD EXCEED ND1. CCCC WRITE(KFILDO,2004)K,CCALL(K),LIST(K),LISTD(K),XDATA(K), CCCC 1 DATA(K) CCCC 2004 FORMAT(' AUGMT2 AT 2004--K,CCALL(K),LIST(K),LISTD(K),XDATA(K),', CCCC 1 'DATA(K)',I6,2X,A8,2I8,2F8.1) CCCC 2005 CONTINUE C C ESTABLISH THE MAXIMUM NUMBER OF AUGMENTING STATIONS. C 201 IF(IPREX2.EQ.0)THEN C THIS DEFAULT USED BECAUSE CONTROL FILES SET C UP BEFORE THIS CHANGE WILL HAVE IPREX2 = 0. C THIS ESTABLISHES THE DEFAULT TO 5, WHAT IT WAS C PREVIOUSLY. IPRNO=5 ELSE IPRNO=IPREX2 ENDIF C D WRITE(KFILDO,2012)LL,JONE,JTWO,JTHREE D2012 FORMAT(/' AT 2012--LL,JONE,JTWO,JTHREE',4I4) C C SKIP LOOP IF THIS AUGMENTATION PASS IS NOT DONE. C IF(LL.EQ.1.AND.(JONE.EQ.0.OR.JONE.EQ.3))GO TO 250 IF(LL.EQ.2.AND.(JTWO.EQ.0.OR.JTWO.EQ.3))GO TO 250 IF(LL.EQ.3.AND.(JTHREE.EQ.0.OR.JTHREE.EQ.3))GO TO 250 C DO 221 K=1,NSTA ICANADA=0 C IF(NAREA.EQ.1)THEN C IF((STALAT(K).GE.50.AND.STALON(K).GE.85.AND. 1 STALON(K).LE.130).OR.(STALAT(K).GE.47.5.AND. 2 STALON(K).GE.55.AND.STALON(K).LE.85))THEN C CANADIAN STATION ABOVE 50 DEGREES LATITUDE C (OR 47.5 N) IS TREATED SPECIALLY TO GUARANTEE C VALUES NEAR THE TOP GRID BORDER. ICANADA=1 ENDIF C ENDIF C CCCC IF(CCALL(K).EQ.'CNIC1 ')THEN CCCC WRITE(KFILDO,9014)K,CCALL(K),XDATA(K),DATA(K),SDATA(K), CCCC 1 LNDSEA(K),ICANADA,L,LL CCCC 9014 FORMAT(/' AT 9014--K,CCALL(K),XDATA(K),DATA(K),SDATA(K),', CCCC 1 'LNDSEA(K),ICANADA,L,LL',/ CCCC 2 I7,1X,A8,3F8.1,4I4) CCCC ENDIF C C SET IREPL(1) = 1 WHEN THIS STATION IS TO BE USED AT ALL; C = 0 OTHERWISE. C SET IREPL(2) = 1 WHEN THIS STATION IS TO BE USED EVEN THOUGH C IT CANNOT BE ADJUSTED BY BASE DATA; C = 0 OTHERWISE. NOTE THAT THIS IS 1 WHEN IT C IS TO BE MOS TREND ADJUSTED. IF THE C TREND CANNOT BE DONE, IT IS NOT USED. C MPROB=IDPARS(6)-(IDPARS(6)/100)*100 C MPROB IS THE PROBABILITY LEVEL WHEN L = 6, 7, 8, OR 9. C WHEN OTHER EKDMOS PROBABILITIES ARE ADDED, THIS WILL C BE MODIFIED. C IREPL(1)=0 IREPL(2)=0 C SET IREPL( ) AS A SAFETY. C IF((L.GE.6.AND.L.LE.9).AND.MPROB.NE.0)THEN IREPL(1)=0 IREPL(2)=0 C EKDMOS PROBABILITIES ARE NOT REPLACED. C ELSEIF(L.EQ.12.OR.L.EQ.13.OR.(L.GE.16.AND.L.LE.18))THEN C SETS IREPL( ) FOR OBS TEMP, DEWPOINT, WIND SPEED, C U, AND V. CALL IROBS(KFILDO,ID,IDPARS,CCALL(K),LNDSEA(K),LTAG(K), 1 K,L,LL,ICANADA,IREPL,ISTOP(1),IER) C ELSEIF(L.EQ.19)THEN C SETS IREPL( ) FOR OBS TOTAL WIND. CALL IROBTW(KFILDO,ID,IDPARS,CCALL(K),LNDSEA(K),LTAG(K), 1 K,L,LL,ICANADA,IREPL,ISTOP(1),IER) C ELSEIF(L.LE.5)THEN C SETS IREPL( ) FOR LAMP TEMP, DEWPOINT, WIND SPEED, U, C AND V. CALL IRLMP(KFILDO,ID,IDPARS,CCALL(K),XDATA(K), 1 IBTAG1(K),IBTAG2(K), 1 DATA(K),LNDSEA(K),LTAG(K),K,L,LL,ICANADA, 2 IREPL,ISTOP(1),IER) C ELSEIF(L.EQ.20)THEN C THIS IS FOR LAMP TOTAL WIND. CALL IRLMTW(KFILDO,ID,IDPARS,CCALL(K),LNDSEA(K),LTAG(K), 1 K,L,LL,ICANADA,IREPL,ISTOP(1),IER) ELSE C THIS IS THE DEFAULT IF NOT HANDLED ABOVE. IREPL(1)=1 IREPL(2)=1 ENDIF C IF(IER.EQ.777)THEN C AN ERROR HAS OCCURRED IN IROBS, IROBTW, IRLMP, OR C IRLMTW. ISTOP(1) HAS BEEN INCREMENTED WITH A DIAGNOSTIC. C DO NOT PROCEED. GO TO 900 ENDIF C C SET ANY LTAG( ) = -1 TO +4, BUT ONLY ON THE LAST LL. C NOTE THAT IRLMP INSURES THAT LTAG( ) = 0 FOR PROJECTION 1 C WHEN LAMP IS PRESENT AND WHEN MOS IS TO BE ACCEPTED. C LTAG( ) MAY BE LATER SET TO ZERO TO ACCEPT MOS WHEN C THE OBS TOSS WAS AN OB. HOWEVER, U-WIND SHOULD NOT C ACCEPT MOS OR LAMP IF IT WAS TOSSED IN SPEED, AND V-WIND C SHOULD NOT ACCEPT MOS OR LAMP IF IT WAS TOSSED IN SPEED C OR U-WIND. C IF(LL.EQ.NUMAUG)THEN C IF(LTAG(K).EQ.-1)THEN LTAG(K)=4 CCCC WRITE(KFILDO,9015)CCALL(K) CCCC 9015 FORMAT(' LTAG( ) CHANGED FROM -1 TO +4 FOR STATION ',A8) ENDIF C ENDIF IF(XPL(K).LT.RMINXY.OR.YPL(K).LT.RMINXY.OR. 1 XPL(K).GT.RMAXX.OR.YPL(K).GT.RMAXY)THEN C THE STATION IS NOT WITHIN RLIMIT=R*RSTAR GRIDLENGTHS OF C THE ANALYSIS GRID, DON'T REPLACE IT, AND IT WON'T BE C COUNTED AS BEING REPLACED. GO TO 220 C ELSEIF(XDATA(K).LT.9998.5.AND.(L.NE.19.AND.L.NE.20))THEN C THIS MEANS THE DATUM IS THERE AND DOESN'T NEED C TO BE FABRICATED, EXCEPT FOR TOTAL WIND (OBS AND LAMP). GO TO 220 C ELSEIF(DATA(K).GT.9998.5)THEN C TRANSFER MEANS THE AUGMENTING VALUE IS MISSING, SO CAN'T C USE IT. GO TO 220 ENDIF C CCCC IF(CCALL(K).EQ.'CNIC1 ')THEN CCCC WRITE(KFILDO,2015)K,CCALL(K),LL,L,XDATA(K),DATA(K),SDATA(K), CCCC 1 LNDSEA(K),IREPL(1),IREPL(2),ICANADA,L,LL CCCC 2015 FORMAT(/' AT 2015--K,CCALL(K),LL,L,XDATA(K),DATA(K),SDATA(K),', CCCC 1 'LNDSEA(K),IREPL(1),IREPL(2),ICANADA,L.LL',/ CCCC 2 I7,1X,A8,2I4,3F8.1,6I4) CCCC ENDIF C IF(IREPL(1).EQ.0)GO TO 220 C THERE IS NO USE TO CONTINUE IF THE VALUE IS NOT GOING TO C BE USED. C C SUM AND KOUNT ARE INITIALIZED UP HERE SO THAT C DIAGNOSTIC PRINT IS OK. C SUM=0. C SUM SUMS THE DELTAS BETWEEN THE TWO SETS OF DATA. SUMX=0. C SUMX SUMS LAMP VALUES FOR THE SAME SET USED IN SUM. KOUNT=0 C C AUGMENT THE LIST OF DATA IN XDATA( ). USE A TEMPORARY C ARRAY. C IF(LIST(K).NE.999999)THEN C THIS IS THE TERMINATOR. C CCCC WRITE(KFILDO,2016)K,LIST(K),LISTD(K),NOALOC(LIST(K)), CCCC 1 IALOC(LIST(K),1),CCALL(K),LNDSEA(K) CCCC 2016 FORMAT(/' AT 2016--K,LIST(K),LISTD(K),NOALOC(LIST(K)),', CCCC 1 'IALOC(LIST(K),1),CCALL(K),LNDSEA(K)',5I9,2X,A8,I2) C C TAKE CARE OF OBS AND LAMP TOTAL WIND FIRST, WHICH USES C NO DELTA, BUT AUGMENTS WITH GUSTS. THE AUGMENTATION C SEQUENCE IS SUCH THAT AN INSERTION IS MADE ONLY IF C A PREVIOUS ONE HAS NOT BEEN MADE AND IT WOULD C INCREASE THE INCOMING (BASE) VALUE. C C THE SEQUENCE IS: C (19) AUGMENTED OBS SPEED (BASE), C (1)OBS GUSTS, (2) MOS GUSTS, (3) OBS GUSTS 1-H OLD C (20) AUGMENTED LAMP SPEED (BASE), C (1)LAMP GUSTS, (2) MOS GUSTS, (3) OBS GUSTS ON TIME, C (4) OBS GUSTS 1 HOUR OLD. C IF(L.EQ.19.OR.L.EQ.20)THEN C C CHECK LEGITIMACY OF LNDSEA(K) AND SET INDEX KT FOR C KTLLB( , ). C KT=LNDSEA(K)/3+1 C IF(KT.LT.1.OR.KT.GT.4)THEN GO TO 220 C THIS STATION IS NOT USED. NOT LEGITIMATE LNDSEA( ) C VALUE. A DIAGNOSTIC HAS BEEN PRINTED AT 1018. ENDIF C IF(IREPL(1).EQ.1)THEN TEMP(K,LL,1)=DATA(K) TEMP(K,LL,2)=0 ELSE TEMP(K,LL,1)=9999. TEMP(K,LL,2)=0 ENDIF C ELSEIF(NOALOC(LIST(K)).NE.9999)THEN C CCCCCD IF(LISTD(K).NE.999999)THEN CCCCCC CCCCCD LOC=LISTD(IALOC(LIST(K),1)) CCCCCC NOTE THE 1. C CCCCD IF(LOC.NE.999999)THEN CCCCD WRITE(KFILDO,2018)K,LIST(K),LISTD(K), CCCCD 1 IALOC(LIST(K),1),LOC CCCCD2018 FORMAT(/' AT 2018--K,LIST(K),LISTD(K),', CCCCD 1 'IALOC(LIST(K),1),LOC',6I10) C CCCCD WRITE(KFILDO,202)K,CCALL(K),LIST(K),NOALOC(LIST(K)), CCCCD 1 XDATA(K),DATA(K),XDATA(LOC), CCCCD 2 DATA(LOC) CCCCD202 FORMAT(/,' AT 202--K,CCALL(K),LIST(K),', CCCCD 1 'NOALOC(LIST(K)),', CCCCD 2 'XDATA(K),DATA(K),XDATA(LOC),DATA(LOC)',/, CCCCD 3 I7,2X,A8,I8,I3,4F8.1) CCCCCD ENDIF C CCCCCD ENDIF C C BELOW IS FOR WHEN THE AUGMENTING DATUM IS NOT MISSING AND C CAN BE USED FOR REPLACEMENT. C DO 205 MM=1,NOALOC(LIST(K)) C IF(IALOC(LIST(K),MM).GT.IALL)THEN C THIS IS A SAFETY AND SHOULD NOT HAPPEN. WRITE(KFILDO,2020) 2020 FORMAT(/' ****ERROR IN AUGMT2 AT 2020.', 1 ' THIS SHOULD NOT HAPPEN. CONTINUING.') GO TO 205 ENDIF C LOC=LISTD(IALOC(LIST(K),MM)) C IF(LOC.EQ.999999)THEN C WRITE(KFILDO,2021) 2021 FORMAT('STATION IN PAIRS LIST IS NOT A', 1 ' STATION BEING ANALYZED, SO CANNOT BE USED IN', 2 ' AUGMENTATION.') C CCC WRITE(KFILDO,2022)K,MM,LIST(K),LISTD(K), CCC 1 IALOC(LIST(K),MM),LOC CCC 2022 FORMAT(' AT 2022--K,MM,LIST(K),LISTD(K),', CCC 1 'IALOC(LIST(K),MM),LOC',6I9) GO TO 205 ENDIF C CCCCD IF(CCALL(K).EQ.'260150 '.OR. CCCCD 1 CCALL(K).EQ.'042319 ')THEN CCCCC 260150 IS AT 2450 FT CCCCC 042319 IS DEATH VALLEY AT -194 FT CCCC IF(CCALL(K).EQ.'CNIC1 ')THEN CCCC WRITE(KFILDO,2025)K,CCALL(K),XDATA(K),DATA(K), CCCC 1 CCALL(LOC),XDATA(LOC),DATA(LOC), CCCC 2 TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1), CCCC 3 IREPL(1),IREPL(2),LL CCCC 2025 FORMAT(/' AT 2025--K,CCALL(K), XDATA(K), DATA(K)', CCCC 1 ' CCALL(LOC),XDATA(LOC),DATA(LOC),', CCCC 2 ' TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1),', CCCC 3 'IREPL(1),IREPL(2),LL',/ CCCC 4 I11,3X,A8,F8.1,F11.1,2X,A8,F8.1,F10.1, CCCC 5 6X,3F10.1,3I7) CCCC ENDIF C IF(XDATA(LOC).LT.9998.5.AND. 1 DATA(LOC).LT.9998.5)THEN C IF(ABS(XDATA(LOC)-DATA(LOC)).LE.30.)THEN SUM=SUM+XDATA(LOC) 1 -DATA(LOC) SUMX=SUMX+XDATA(LOC) KOUNT=KOUNT+1 ENDIF C QC PROCEDURE FOR THE SUM COMPUTATION TO NOT USE C BAD DATA FOR T/TD/WIND (NEED TO LOOK AT OTHERS LATER). C IF(KOUNT.GE.IPRNO)GO TO 2050 C LIMIT AVERAGING TO IRPNO STATIONS. THE STATION C LIST IS ORDERED AS TO PERCEIVED "CLOSENESS." STATIONS C ARE ORDERED AS TO CLOSENESS IN DISTANCE, BUT IN THREE C ELEVATION BANDS. SO THE IPRNO "CLOSEST" ONES WITH DATA C WILL BE USED. IPRNO DEFAULTS TO 5 WHEN INCOMING C IPREX2 = 0. ENDIF C 205 CONTINUE C 2050 CONTINUE C CCCC WRITE(KFILDO,9051)K,CCALL(K),XDATA(K), CCCC 1 DATA(K),TEMP(K,LL,1),LL, CCCC 2 LTAG(K) CCCC 9051 FORMAT(/' AT 9051 IN AUGMT2--K,CCALL(K),', CCCC 1 'XDATA(K),DATA(K),TEMP(K,LL,1),', CCCC 2 'LL,LTAG(K)',I6,1X,A8,3F7.1,2I6) C IF(KOUNT.GE.2)THEN C THIS IS SET TO REQUIRE A MINIMUM OF 2 STATIONS FOR C AVERAGING. KOUNT SHOULD NORMALLY BE GE 2. C DELTA=SUM/KOUNT AVGLMP=SUMX/KOUNT C IF(L.LE.5.AND.LL.GE.2.AND.IDPARS(12).LE.3)THEN C THE ALGORITHM BELOW WILL WORK FOR ANY IDPARS(12). DELTA=DELTA*((MIN(IDPARS(12)+LL-2,3))/3.) C FOR LAMP, THE ADJUSTMENT IS 1/3 FOR FIRST C PROJECTION, FOR ON-TIME OBS,2/3 FOR 2ND PROJECTION C FOR ON-TIME OBS, THEN FULL THEREAFTER FOR ON-TIME C OBS. THE ADJUSTMENT IS 2/3 FOR PROJECTION 1 FOR C 1-H OLD OBS, AND FULL ADJUSTMENT THEREAFTER. C FULL ADJUSTMENT FOR MOS ONLY (LL = 1). CCCC WRITE(KFILDO,2051)CCALL(K),DELTA,LL CCCC 2051 FORMAT(' AT 2051--CCALL(K),DELTA,LL ', CCCC 1 A8,F10.2,I4) ENDIF C IF(DATA(K).LT.9998.5.AND.IREPL(1).EQ.1)THEN C THIS IS AN UNNECESSARY CHECK ON DATA(K). C IF DATA( ) IS MISSING, TEMP( , ,1) IS LEFT MISSING; C AUGMENTATION CAN'T BE DONE. C THE AVERAGING HAS BEEN DONE, SO REPLACEMENT DEPENDS C ON IREPL(1). C IF(ICOR.EQ.0)THEN C APPLY A POSITIVE OR NEGATIVE DELTA. THIS C APPLIES TO MOST VARIABLES EXCEPT FOR C TEMPERATURE AND FOR DEWPOINT AUGMENTED BY C THE MIN. C C IF(L.GE.3.AND.L.LE.5.AND.LL.GE.2.AND. C 1 IDPARS(12).GE.3)THEN C THIS IS FOR LAMP S, U, AND V. IT COMBINES C THE DELTA WITH THE LAMP AVERAGE. THIS C LESSENS THE EFFECT OF THE OBS FOR C PROJECTIONS GE 3. ON AUG. 8, THIS WAS REMOVED C BASED ON VERIFICATION GRIDS C TEMP(K,LL,1)=(DATA(K)+DELTA)*TPROJ(IDPARS(12),L) C 1 +AVGLMP*(1.-TPROJ(IDPARS(12),L)) C ELSE TEMP(K,LL,1)=DATA(K)+DELTA C ENDIF C CCCC IF(CCALL(K).EQ.'UP471 ')THEN CCCC WRITE(KFILDO,2345)K,CCALL(K),L,LL,IDPARS(12), CCCC 1 XDATA(K),DATA(K),DELTA,AVGLMP, CCCC 2 TPROJ(IDPARS(12),L),TEMP(K,LL,1) CCCC 2345 FORMAT(/' AT 2345--K,CCALL(K),L,LL,IDPARS(12),', CCCC 1 'XDATA(K),DATA(K),DELTA,AVGLMP,', CCCC 2 'TPROJ(IDPARS(12),L),TEMP(K,LL,1)',/, CCCC 3 I6,2X,A8,3I4,6F8.2) CCCC ENDIF C TEMP(K,LL,2)=1 IF(LTAGPT(K).EQ.0)LTAGPT(K)=LL C LTAGPT( ) INDICATES A 1ST, 2ND, OR HIGHER LEVEL C AUGMENTATION. HIGHER LEVELS ARE LATER SET TO 2. C CCCCC IF(CCALL(K).EQ.'CNIC1 ')THEN CCCCC WRITE(KFILDO,2052)K,CCALL(K),XDATA(K), CCCCC 1 DATA(K),DELTA,TEMP(K,LL,1),LL, CCCCC 2 LTAG(K) CCCCC 2052 FORMAT(/' AT 2052 IN AUGMT2--K,CCALL(K),', CCCCC 1 'XDATA(K),DATA(K),DELTA,TEMP(K,LL,1),', CCCCC 2 'LL,LTAG(K)',I6,1X,A8,4F7.1,2I6) CCCCC ENDIF C ELSEIF(ICOR.EQ.1)THEN C APPLIES TO AUGMENTATION BY MAX/MIN. C IF(DELTA.GT.0.)THEN TEMP(K,LL,1)=DATA(K)+DELTA C APPLY A POSITIVE DELTA TO TEMPERATURE BASED C ON MIN. TEMP(K,LL,2)=1 ELSE TEMP(K,LL,1)=DATA(K) C SET THE VALUE TO THE MIN. TEMP(K,LL,2)=1 ENDIF C IF(LTAGPT(K).EQ.0)LTAGPT(K)=LL C LTAGPT( ) INDICATES A 1ST, 2ND, OR HIGHER LEVEL C AUGMENTATION. HIGHER LEVELS ARE LATER SET TO 2. C CCCCD WRITE(KFILDO,2064)CCALL(K),DELTA CCCCD2064 FORMAT(/' AT 2064 AUGMENTING CCALL(K) = ',A8, CCCCD 1 ' WITH DELTA = ',F10.1) C ELSEIF(ICOR.EQ.2)THEN C APPLIES TO AUGMENTATION BY MAX/MIN. C IF(DELTA.LT.0.)THEN TEMP(K,LL,1)=DATA(K)+DELTA C APPLY A NEGATIVE DELTA TO TEMPERATURE BASED C ON MAX. TEMP(K,LL,2)=1 ELSE TEMP(K,LL,1)=DATA(K) C SET THE VALUE TO THE MAX. TEMP(K,LL,2)=1 ENDIF C IF(LTAGPT(K).EQ.0)LTAGPT(K)=LL C LTAGPT( ) INDICATES A 1ST, 2ND, OR HIGHER LEVEL C AUGMENTATION. HIGHER LEVELS ARE LATER SET TO 2. C ELSE C THIS SHOULD NOT HAPPEN; ICOR = 0, 1, OR 2 ONLY. WRITE(KFILDO,2065)ICOR 2065 FORMAT(/' ****ERROR AT 2065. ICOR =',I5, 1 ' NOT ONE ITS LEGITIMATE VALUES = ', 2 'O, 1, OR 2. PROCEEDING.') ENDIF C ENDIF C ELSE C C IF THERE ARE NO DATA TO AVERAGE IN THE LIST, THEN C SET XDATA( ) = DATA( ) WHEN IREPL(2) = 1. C (NO DATA = ONLY ONE STATION WITH DATA.) IT HAS C ALREADY BEEN DETERMINED THAT XDATA( ) IS NOT GOOD, C AND IF DATA( ) IS MISSING, XDATA( ) IS JUST RESET C TO MISSING. THE REPLACEMENT MAY BE IMPORTANT FOR C WATER STATIONS, BUT THE POSSIBLE DIFFERENCES OVER C LAND MAKE REPLACEMENT QUESTIONABLE. ALSO, LAND C STATIONS ARE MORE DENSE AND REPLACEMENT IS NOT AS C NECESSARY. HOWEVER, THIS REPLACEMENT IS NOT FOR C EKDMOS PROBABILITIES; IREPL(2) GOVERNS THE C REPLACEMENT. C C THE DIAGNOSTIC PRINT BELOW CAN BECOME VOLUMINOUS C AND IS LIKELY TOO MUCH TO USE EXCEPT IN CHECKOUT. C IF TWO CYCLES ARE AVERAGED, ONE CAN BE MISSING C AND THE OTHER NOT; THE ONE NOT MISSING IS USED. C CCC WRITE(KFILDO,2067)K,CCALL(K),LNDSEA(K),IREPL(1), CCC 1 IREPL(2),XDATA(K),DATA(K) CCC 2067 FORMAT(' AT 2067--)K,CCALL(K),LNDSEA(K),IREPL(1),', CCC 1 'IREPL(2),XDATA(K),DATA(K)',I6,2X,A8,3I6,2F8.1) C C IF(IREPL(2).EQ.1)THEN TEMP(K,LL,1)=DATA(K) TEMP(K,LL,2)=0 C D WRITE(KFILDO,2068)CCALL(K),NAME(K),LNDSEA(K),DATA(K), D 1 LL D2068 FORMAT(' ####REPL MISSNG DATUM FOR', D 1 ' STATION ',2X,A8,A20,' TYPE',I3, D 2 ' WITH UNAUGMENTED VALUE',F7.1, D 3 ' LIST AVERAGING FAILED LEVEL',I2) C IF(LTAGPT(K).EQ.0)LTAGPT(K)=LL C LTAGPT( ) INDICATES A 1ST, 2ND, OR HIGHER LEVEL C AUGMENTATION. HIGHER LEVELS ARE LATER SET TO 2. C ELSE WRITE(KFILDO,2170)CCALL(K),NAME(K),LNDSEA(K),LL 2170 FORMAT(' ####LIST AVERAGING FAILED', 1 ' STATION ',A8,A20,' STATION TYPE =',I3, 2 ' VALUE NOT REPLACED, AUGMENTATION LEVEL', 3 I2) ENDIF C ENDIF C ELSE C C IF THERE ARE NO STATIONS IN LIST, REPLACE XDATA( ) WITH C DATA( ) WHEN XDATA( ) IS MISSING AND IREPL(2) = 1. THERE C MAY BE A MISSING LIST BECAUSE OF SOME REASON LIKE NOT C USING THE SAME STATION LIST IN U155 AND U179. THE C REPLACEMENT IS DEFINED BY IREPL(2). C IF(IREPL(2).EQ.1)THEN C IF(ISPACE.EQ.0)THEN WRITE(KFILDO,2175) 2175 FORMAT(' ') ISPACE=1 ENDIF C IF(XDATA(K).GT.9998.5)THEN C REPLACE ONLY WHEN MISSING. C IF(DATA(K).LT.9998.5)THEN C AN UNNECESSARY TEST. C D WRITE(KFILDO,2176)CCALL(K),NAME(K),LNDSEA(K), D 1 DATA(K),LL D2176 FORMAT(' ####NO BASE DATUM FOR STATION', D 1 3X,A8,A20,' TYPE',I3, D 2 ' IT IS REPLACED WITH UNAUGMENTED', D 3 ' VALUE',F8.2,' LEVEL',I2 ) C TEMP(K,LL,1)=DATA(K) C THIS DOES NOT HAPPEN WHEN IREPL(2) = 0 C FOR A 2ND LEVEL AUGMENTATION. TEMP(K,LL,2)=0 IF(LTAGPT(K).EQ.0)LTAGPT(K)=LL C LTAGPT( ) INDICATES A 1ST, 2ND, OR HIGHER LEVEL C AUGMENTATION. HIGHER LEVELS ARE LATER SET TO 2. C CCCC WRITE(KFILDO,9995)K,CCALL(K),L,LL, CCCC 1 DATA(K),XDATA(K),LL1OCA,LL1LAK,LL1LND, CCCC 2 LL2OCA,LL2LAK,LL2LND CCCC 9995 FORMAT(' REPLACING WATER STA AT 9995--', CCCC 1 'K,CCALL(K),L,LL,', CCCC 2 'DATA(K),XDATA(K),LL1OCA,LL1LAK,LL1LND,', CCCC 3 'LL2OCA,LL2LAK,LL2LND',/, CCCC 4 ' ',I7,2X,A8,2I2,2F7.1,6I4) ENDIF C ENDIF C ELSE C IF(ISPACE.EQ.0)THEN WRITE(KFILDO,2175) ISPACE=1 ENDIF C WRITE(KFILDO,2180)CCALL(K),NAME(K),LNDSEA(K),LL 2180 FORMAT(' ####THERE IS NO LIST FOR STATION', 1 3X,A8,A20,' TYPE',I3,' MISSING DATUM IS NOT', 2 ' REPLACED LEVEL',I2) ENDIF C ENDIF C CCCC IF(CCALL(K).EQ.'CNIC1 ')THEN CCCC WRITE(KFILDO,2181)K,CCALL(K),XDATA(K),DATA(K), CCCC 1 TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1), CCCC 2 IREPL(1),IREPL(2),LL,ICANADA CCCC 2181 FORMAT(/' AT 2181--K,CCALL(K),XDATA(K),DATA(K),', CCCC 1 'TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1),', CCCC 2 'IREPL(1),IREPL(2),LL,ICANADA',/ CCCC 3 I8,2X,A8,5F8.1,4I4) CCCC ENDIF C IF(JFIRST.EQ.0)THEN WRITE(KFILDO,2185) 2185 FORMAT(' ') ISTOP(1)=ISTOP(1)+1 ENDIF C IF(JFIRST.LE.1)THEN WRITE(KFILDO,219)K,LIST(K),CCALL(K),NAME(K) 219 FORMAT(' ****STATION IN ANALYSIS LIST NOT IN AUGMENTATION', 1 ' LIST. K,LIST(K),CCALL(K) ARE',I6,I10,2X,A8,A20) JFIRST=JFIRST+1 ENDIF C C****************************** IF(JFIRST.EQ.2)THEN IF(JFIRST.EQ.40000)THEN WRITE(KFILDO,2190) 2190 FORMAT(' THIS DIAGNOSTIC WILL NOT PRINT AGAIN FOR', 1 ' THIS AUGMENTATION. COUNTED AS ONE ISTOP ERROR.') JFIRST=JFIRST+1 ENDIF C C****************************** IF(JFIRST.GT.2)THEN IF(JFIRST.GT.40000)THEN JFIRST=JFIRST+1 ENDIF C ELSE WRITE(KFILDO,2191)CCALL(K) 2191 FORMAT(' AT 2191--CCALL(K) ',A8) ENDIF C 220 CONTINUE C CCCC IF(CCALL(K).EQ.'DUMMY ')THEN CCCC WRITE(KFILDO,2195)K,CCALL(K),IREPL(1),IREPL(2),KOUNT, CCCC 1 LTAGPT(K),DATA(K),XDATA(K),(TEMP(K,N,1),N=1,3), CCCC 2 (TEMP(K,N,2),N=1,3),LNDSEA(K),LL,LTAG(K) CCCC 2195 FORMAT(/' AT 2195--(K,CCALL(K),IREPL(1),IREPL(2),KOUNT,', CCCC 1 'LTAGPT(K),DATA(K),XDATA(K),(TEMP(K,N,1),N=1,3),', CCCC 2 '(TEMP(K,N,2),N=1,3)LNDSEA(K),LL,LTAG(K)',/ CCCC 3 I6,2X,A8,3I2,2X,I2,5F7.1,3X,3F7.1,4I3) CCCC ENDIF C 221 CONTINUE C CCCCD DO 225 K=1,MIN(IALL,ND1) CCCCC IALL COULD EXCEED ND1. CCCCD WRITE(KFILDO,224)K,CCALL(K),LIST(K),LISTD(K),XDATA(K), CCCCD 1 DATA(K),LTAGPT(K) CCCCD224 FORMAT(' AUGMT2 AT 224--K,CCALL(K),LIST(K),LISTD(K),XDATA(K),', CCCCD 1 'DATA(K),LTAGPT(K)', CCCCD 2 I6,2X,A8,2I8,2F8.1,I5) CCCCC NOTE THAT THESE VALUES MAY NOT BE SCALED, DEPENDING ON THE CCCCC ORDER OF SCALING ROUTINE AND AUGMT2 IN U405A.CN FILE. CCCCD225 CONTINUE C IF(LL.EQ.1)THEN JONE=2 C JONE = 2 SIGNIFIES THE 1ST LEVEL OF AUGMENTATION WAS DONE. ELSEIF(LL.EQ.2)THEN JTWO=2 C JTWO = 2 SIGNIFIES THE 2ND LEVEL OF AUGMENTATION WAS DONE. ELSE JTHREE=2 C JTHREE= 2 SIGNIFIES THE 3RD LEVEL OF AUGMENTATION WAS DONE. ENDIF C 250 CONTINUE C C ALL LEVELS OF AUGMENTING DATA NOW IN TEMP( , , ). C C COMPUTE NUMBER OF VALUES FOR ANALYSIS. C JTEST=0 C DO 2502 K=1,NSTA C IF(XDATA(K).GT.9998.5)THEN C IF((TEMP(K,1,1).LT.9998.5).OR. 1 (TEMP(K,2,1).LT.9998.5).OR. 2 (TEMP(K,3,1).LT.9998.5))THEN JTEST=JTEST+1 ENDIF C ENDIF C 2502 CONTINUE C IF(L.LE.5)THEN C JTEST IS NOW THE NUMBER OF AUGMENTATION VALUES. THIS C WITH NUMOBS CONTROLS WHETHER THE WEIGHT ON MOS WILL C BE DECREASED FROM 1.0. NOTE THAT THIS ONLY PERTAINS TO C LAMP TEMPERATURE, DEWPOINT, WIND SPEED, U-WIND, AND V-WIND, C NOT OBS OR TOTAL WIND. C IF(JTEST.LT.NUMOBS)THEN JTWO=4 WRITE(KFILDO,2503)JTEST,NUMOBS 2503 FORMAT(/' ****TOTAL MOS+OBS AUGMENTING VALUES', 1 ' FOUND =',I6,' WHEN PRIMARY DATA MISSING.'/ 1 ' LESS THAN THE NUMBER REQUIRED =',I6, 2 '. WEIGHT ON MOS USED AS 1.') QUAL1=1. ISTOP(1)=ISTOP(1)+1 C ELSE IF(IDPARS(4).EQ.5)THEN WRITE(KFILDO,2504)JTEST,NUMOBS 2504 FORMAT(/' TOTAL OF',I6,' MOS+OBS AUGMENTING', 1 ' VALUES FOUND WHEN PRIMARY DATA MISSING.'/ 2 ' EXCEEDS THRESHOLD OF',I6,' REQUIRED FOR', 3 ' NORMAL WEIGHTING OF MOS FOR LAMP.') ENDIF C ENDIF C ENDIF C C AT THIS POINT, TEMP(K,LL, ) HAS BEEN FILLED. NO DATA HAVE C YET BEEN PLACED IN XDATA( ), SO IT STILL CONTAINS THE C INCOMING DATA WITHOUT ANY AUGMENTATION. THIS INTERMEDIATE C STORAGE WAS NECESSARY BECAUSE THE PLACEMENT OF DATA IN C XDATA( ) CANNOT BE DETERMINED UNTIL ALL POSSIBLE C AUGMENTATION DATA ARE CONSIDERED. C C TREAT LEVEL 3 AS BACKUP TO LEVEL 2, BUT ONLY FOR LAMP C TEMPERATURE, DEWPOINT, WIND SPEED, U-WIND, ANV V-WIND. C IF(JTHREE.EQ.2.AND.L.LE.5)THEN C DO 2507 K=1,NSTA C IF(TEMP(K,2,1).GT.9998.5)THEN C IF(TEMP(K,3,1).LT.9998.5)THEN TEMP(K,2,1)=TEMP(K,3,1) TEMP(K,2,2)=TEMP(K,3,2) TEMP(K,3,1)=8888. C THIS IS FOR USE LATER TO INDICATE LEVEL 2 IS REALLY C LEVEL 3. ENDIF C ENDIF C C LTAGPT( ) WAS SET TO LL FOR CHECKOUT AND DIAGNOSTICS FOR THE C HIGHER LEVELS OF AUGMENTATION. HOWEVER, 3 REPRESENTS BOGUS C VALUES IN OTHER PROGRAMS, SO MUST BE CHANGED BACK TO 2. C IF(LTAGPT(K).GE.3)THEN LTAGPT(K)=2 ENDIF C 2507 CONTINUE C C AT THIS POINT, TEMP( ,2,1) CONTAINS DATA TO USE WHETHER C FROM THE 2ND OR 3RD LEVEL. CONSIDER THE 2ND LEVEL C SUCCESSFUL EVEN IF IT FAILED AND LEVEL 3 SUCCEEDED. C IF LEVEL THREE WAS NOT DONE OR FAILED, JTWO IS NOT C CHANGED. TEMP( ,3,1) = 8888. WHEN THE AUGMENTING DATUM C ACTUALLY CAME FROM LEVEL 3. THIS IS JUST FOR COUNTING C PURPOSES. C ENDIF C C FOR LAMP TEMP, TD, AND WIND, ADJUST THE OBS BY C A TREND FROM PROJECTION 1 TO PROJECTION IDPARS(2) C FOR OCEAN AND LAKE STATIONS, ALSO FOR AN AREA IN CANADA. C FOR AUGMTO TO OPERATE CORRECTLY, IT MUST BE CALLED FOR C PROJECTION 1. C C IF(L.LE.5.OR.L.EQ.20)THEN C IF(L.LE.5)THEN MOS=1 NOB=2 C FOR LAMP OTHER THAN TOTAL WIND, MOS IS IN THE C FIRST COLUMN OF TEMP( , , ) AND OBS IN THE 2ND. ELSE MOS=2 NOB=3 C FOR LAMP TOTAL WIND, MOS IS IN THE 2ND COLUMN C OF TEMP( , , ) AND OBS IN THE 3RD. ENDIF C CALL AUGMTO(KFILDO,KFIL10,IP16,MDATE,ID,IDPARS(12),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) IF(IER.NE.0)KER=1 C AN ERROR FROM AUGMTO IS NOT FATAL, BUT ITS OCCURRENCE C IS TAKEN BACK TO U405A. IER=0 ENDIF C C THIS IS WHERE XDATA( ) IS REPLACED FOR TOTAL WIND OBS. C QUALST( ) NEED NOT BE MODIFIED; STATION VALUES STILL APPLY. C IF(L.EQ.19)THEN C DO 2510 K=1,NSTA C C CHECK LEGITIMACY OF LNDSEA(K) AND SET INDEX KT FOR C KTLLB( , ). C KT=LNDSEA(K)/3+1 C IF(KT.LT.1.OR.KT.GT.4)THEN GO TO 2510 C THIS STATION IS NOT USED. NOT LEGITIMATE LNDSEA( ) C VALUE. A DIAGNOSTIC HAS BEEN PRINTED AT 1018. ENDIF C CCCC WRITE(KFILDO,9507)K,CCALL(K),KT,(KTLLB(KT,LL),LL=1,4), CCCC 1 XDATA(K),(TEMP(K,LL,1),LL=1,4) CCCC 9507 FORMAT(/' AT 9507--K,CCALL(K),KT,(KTLLB(KT,LL),LL=1,4)', CCCC 1 'XDATA(K),(TEMP(K,LL,1),LL=1,4)',/, CCCC 2 I6,2X,A8,5I8,5F8.1) C IF(XDATA(K).LT.9998.5)THEN C XDATA( ) HAS A BASE VALUE AND CAN HAVE A GUST. C DO 2509 LL=1,NUMAUG C IF(TEMP(K,LL,1).LT.9998.5)THEN C THE REPLACEMENT VALUE IS NOT MISSING AT LEVEL LL. C FOR THE 2ND LEVEL (MOS) TEMP( , , ) WILL NOT BE C FILLED EXCEPT FOR CANADA AND WATER. C IF(TEMP(K,LL,1).GT.XDATA(K))THEN XDATA(K)=TEMP(K,LL,1) C IF(LL.GT.1)THEN IF(NTAGPT(K).EQ.0)NTAGPT(K)=LL C FOR OBS GUSTS, THE FIRST LEVEL OF C AUGMENTATION IS THE ON=TIME GUSTS, WHICH C IS NOT REALLY AN AUGMENTATION. IN PLATYP, C 2 PLOTS AS ' AND 3 PLOTS AS " C VALUES IN NTAGPT( ) ALSO CONTROL THE C VERIFICAION IN BCD5, SO ON-TIME GUSTS C CAN'T BE TREATED AS AUGMENTATION. IF(LTAGPT(K).EQ.0)LTAGPT(K)=LL-1 C LTAGPT( ) INDICATES LEVEL OF AUGMENTATION. C FOR GUSTS, 1ST LEVEL IS NOT REALLY C AUGMENTATION, SO DECREASE BY 1. CCCC WRITE(KFILDO,8507)CCALL(K),LL,XDATA(K),NTAGPT(K), CCCC 1 LTAGPT(K) CCCC 8507 FORMAT(/' AT 8507--CCALL(K),LL,XDATA(K),NTAGPT(K),', CCCC 1 'LTAGPT(K)',/ CCCC 2 ' ',A8,I3,F8.1,I7,I9) ENDIF C ENDIF C C VALUES IN TEMP( , ) ARE GUST FORECASTS, BUT CAN C BE ZERO FOR NONE. ONCE A GUST IS FOUND, NO C OTHER LEVELS OF AUGMENTATION WILL BE USED. COUNT C IS INCREASED HERE EVEN IF XDATA( ) IS NOT INCREASED. C KTLLB(KT,LL)=KTLLB(KT,LL)+1 CCCC WRITE(KFILDO,2508)K,CCALL(K),LL,KTLLB(KT,LL),XDATA(K) CCCC 2508 FORMAT(' AT 2508--K,CCALL(K),LL,KTLLB(KT,LL),XDATA(K)', CCCC 1 I6,2X,A8,2I8,F8.1) GO TO 2510 C DONE WITH THIS STATION K. USES FIRST GUST C ENCOUNTERED ENDIF C 2509 CONTINUE C ENDIF C 2510 CONTINUE C GO TO 2531 C C THIS IS WHERE XDATA( ) IS REPLACED FOR LAMP TOTAL WIND. C QUALST( ) IS LEFT AT ORIGINAL STATION VALUE, EXCEPT WHEN C ONLY OB IS USED, THEN IT IS MODIFIED BY QUAL2. C ELSEIF(L.EQ.20)THEN C C MAKE ALL REPLACEMENT VALUES DELTAS GE 0. ELIMINATES C MANY TESTS AND COMPUTATIONS BELOW. C DO 2515 K=1,NSTA DO 2514 LL=1,NUMAUG C IF(TEMP(K,LL,1).LT.9998.5)THEN TEMP(K,LL,1)=MAX(TEMP(K,LL,1)-XDATA(K),0.) ENDIF C 2514 CONTINUE 2515 CONTINUE C DO 252 K=1,NSTA C C CHECK LEGITIMACY OF LNDSEA(K) AND SET INDEX KT FOR C KTLLB( , ). C KT=LNDSEA(K)/3+1 C IF(KT.LT.1.OR.KT.GT.4)THEN GO TO 252 C THIS STATION IS NOT USED. NOT LEGITIMATE LNDSEA( ) C VALUE. A DIAGNOSTIC HAS BEEN PRINTED AT 1018. ENDIF C ICANADA=0 C IF(NAREA.EQ.1)THEN C IF((STALAT(K).GE.50.AND.STALON(K).GE.85.AND. 1 STALON(K).LE.130).OR.(STALAT(K).GE.47.5.AND. 2 STALON(K).GE.55.AND.STALON(K).LE.85))THEN C CANADIAN STATION ABOVE 50 DEGREES LATITUDE C (OR 47.5 N) IS TREATED SPECIALLY TO GUARANTEE C VALUES NEAR THE TOP GRID BORDER. ICANADA=1 ENDIF C ENDIF C IF(TEMP(K,3,1).GT.9998.5)THEN TEMP(K,3,1)=TEMP(K,4,1) C wHEN THE 0-H OB IS MISSING, IT IS REPLACED BY C THE 1-H OLD OB, AND THE TWO ARE NOT DIFFERENTIATED. C IF THE 1-H OLD IS MISSING, IT WON'T MATTER. ENDIF C IF(XDATA(K).LT.9998.5)THEN C CCCC WRITE(KFILDO,2516)K,CCALL(K),KT,(KTLLB(KT,LL),LL=1,4), CCCC 1 XDATA(K),(TEMP(K,LL,1),LL=1,4) CCCC 2516 FORMAT(/' AT 2516--K,CCALL(K),KT,(KTLLB(KT,LL),LL=1,4)', CCCC 1 'XDATA(K),(TEMP(K,LL,1),LL=1,4)',/, CCCC 2 I6,2X,A8,5I8,5F8.1) C C XDATA( ) HAS A BASE VALUE AND CAN ACCEPT A DELTA. C IF(TEMP(K,1,1).LT.9998.5.AND. 1 TEMP(K,2,1).LT.9998.5.AND. 2 TEMP(K,3,1).LT.9998.5)THEN C ALL 3 ARE PRESENT, LAMP, MOS, AND OBS. XDATA(K)=XDATA(K)+TEMP(K,1,1)*QUAL1+TEMP(K,3,1)*QUAL2 C WHEN LAMP AND OB ARE THERE, DISREGARD MOS. OBS NEED C TO BE THERE FOR PROJECTION 1 FOR CONTINUITY. C QUAL1 + QUAL2 = 1, BUT BECAUSE THESE ARE NOW DELTAS, C THE TOTAL WEIGHT DOESN'T HAVE TO BE UNITY, BUT C NOT EXCEED 1. C NO CHANGE TO NTAGPT( ) AND LTAGPT( ). BECAUSE LAMP C IS INVOLVED, IT WILL BE IN ASCII FILE AS UN-AUGMENTED. KTLLB(KT,1)=KTLLB(KT,1)+1 KTAVG(KT,3)=KTAVG(KT,3)+1 C ELSEIF(TEMP(K,1,1).LT.9998.5.AND. 1 TEMP(K,2,1).LT.9998.5)THEN C LAMP AND MOS ARE PRESENT, NO OB. XDATA(K)=XDATA(K)+TEMP(K,1,1) C USE LAMP. KTLLB(KT,1)=KTLLB(KT,1)+1 C NO CHANGE TO NTAGPT( ) AND LTAGPT( ), BECAUSE LAMP C IS USED. C ELSEIF(TEMP(K,1,1).LT.9998.5.AND. 1 TEMP(K,3,1).LT.9998.5)THEN C LAMP AND OB ARE PRESENT, NO MOS. XDATA(K)=XDATA(K)+TEMP(K,1,1)*QUAL1+TEMP(K,3,1)*QUAL2 C WEIGHT LAMP AND OB. KTLLB(KT,1)=KTLLB(KT,1)+1 KTAVG(KT,3)=KTAVG(KT,3)+1 C NO CHANGE TO NTAGPT( ) AND LTAGPT( ). BECAUSE LAMP C IS INVOLVED, IT WILL BE IN ASCII FILE AS UN-AUGMENTED. C ELSEIF(TEMP(K,2,1).LT.9998.5.AND. 1 TEMP(K,3,1).LT.9998.5)THEN C MOS AND OB ARE PRESENT, NO LAMP. XDATA(K)=XDATA(K)+TEMP(K,2,1)*QUAL1+TEMP(K,3,1)*QUAL2 C WEIGHT MOS AND OB. KTLLB(KT,2)=KTLLB(KT,2)+1 KTAVG(KT,3)=KTAVG(KT,3)+1 NTAGPT(K)=2 IF(LTAGPT(K).EQ.0)LTAGPT(K)=1 C ASCII FILE WILL INDICATE 2ND LEVEL AUGMENTATION. C LTAGPT(K)=3 MUST BE PRESERVED. C ELSEIF(TEMP(K,1,1).LT.9998.5)THEN XDATA(K)=XDATA(K)+TEMP(K,1,1) C LAMP IS THERE, NO MOS OR OB. USE FULL WEIGHT ON LAMP. KTLLB(KT,1)=KTLLB(KT,1)+1 C NO CHANGE TO NTAGPT( ) AND LTAGPT( ), BECAUSE LAMP C IS USED. C ELSEIF(TEMP(K,2,1).LT.9998.5)THEN C IF(ICANADA.EQ.1.OR.LNDSEA(K).LE.6)THEN C IF CANADA AND WATER ARE HANDLED THE SAME AS CONUS C LAND, THEN THIS TEST IS UNNECESSARY. TO REDUCE C GUST WEIGHT OVER CONUS LAND, ADD QUAL1 TO THE 2ND C STATEMENT. XDATA(K)=XDATA(K)+TEMP(K,2,1) NTAGPT(K)=2 IF(LTAGPT(K).EQ.0)LTAGPT(K)=1 C ASCII WILL INDICATE 2ND LEVEL AUGMENTATION. C LTAGPT(K)=3 MUST BE PRESERVED. C ELSE XDATA(K)=XDATA(K)+TEMP(K,2,1) QUALST(K)=QUALST(K)*QUAL1 NTAGPT(K)=2 IF(LTAGPT(K).EQ.0)LTAGPT(K)=1 C ASCII FILE WILL INDICATE 2ND LEVEL AUGMENTATION. C LTAGPT(K)=3 MUST BE PRESERVED. ENDIF C KTLLB(KT,2)=KTLLB(KT,2)+1 C MOS IS THERE, NO LAMP OR OB. USE LAMP WT, MOS AS PROXY, C EXCEPT OVER WATER AND CANADA, USE FULL WEIGHT. C ELSEIF(TEMP(K,3,1).LT.9998.5)THEN XDATA(K)=XDATA(K)+TEMP(K,3,1)*QUAL2 C OB IS THERE, NO LAMP OR MOS. WEIGHT WITH QUAL2. C HIGH WEIGHT ON PROJECTION 1, VERY LITTLE ON C PROJECTION 25. KTLLB(KT,3)=KTLLB(KT,3)+1 QUALST(K)=QUALST(K)*QUAL2 C NOT ONLY IS THE GUST VALUE DISCOUNTED, THE EFFECT OF THE C STATION IS ALSO DISCOUNTED BECAUSE IT IS OB AND NEEDS C TO FADE OUT. NTAGPT(K)=3 IF(LTAGPT(K).EQ.0)LTAGPT(K)=2 C ASCII FILE WILL SHOW 3RD LEVEL AUGMENTATION. C LTAGPT(K)=3 MUST BE PRESERVED. ENDIF C ENDIF C CCCC WRITE(KFILDO,2517)K,CCALL(K),(KTLLB(KT,LL),LL=1,4),XDATA(K), CCCC 1 QUAL1,QUAL2,IPREX1,PREX3 CCCC 2517 FORMAT(' AT 2517--K,CCALL(K),(KTLLB(KT,LL),LL=1,4),XDATA(K),', CCCC 1 'QUAL1,QUAL2,IPREX1,PREX3',/, CCCC 2 I6,2X,A8,4I8,F8.1,2F8.3,I2,F3.0) C 252 CONTINUE C GO TO 2531 C ENDIF C C THIS IS WHERE XDATA( ) IS REPLACED AS NECESSARY WITH C AUGMENTING VALUES, EXCEPT FOR OBS AND LAMP TOTAL WIND. C WHICH IS DONE ABOVE. ALSO, QUALST( ) IS SET. C XDATA( ) IS FILLED FROM TEMP( , , ), WHICH HAS BEEN C FILLED ONLY IF THE TYPE OF DATA (E.G, MOS) IS TO BE C USED FOR REPLACEMENT. HOWEVER, LTAG( ) COULD STILL C BE EQUAL TO 4. WHENEVER XDATA( ) IS FILLED, IT IS C WITH AN APPROPRIATE VALUE, AND LTAG( ) IS SET TO 0. C DO 253 K=1,NSTA C ICANADA=0 C IF(NAREA.EQ.1)THEN C IF((STALAT(K).GE.50.AND.STALON(K).GE.85.AND. 1 STALON(K).LE.130).OR.(STALAT(K).GE.47.5.AND. 2 STALON(K).GE.55.AND.STALON(K).LE.85))THEN C CANADIAN STATION ABOVE 50 DEGREES LATITUDE C (OR 47.5 N) IS TREATED SPECIALLY TO GUARANTEE C VALUES NEAR THE TOP GRID BORDER. ICANADA=1 ENDIF C ENDIF C CCCC IF(CCALL(K).EQ.'DUMMY ')THEN CCCC WRITE(KFILDO,2526)K,CCALL(K),XDATA(K),DATA(K), CCCC 1 TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1), CCCC 2 QUALST(K),QUAL1,QUAL2, CCCC 3 JONE,JTWO,JTHREE,IPREX5,ICANADA, CCCC 4 LTAGPT(K),NTAGPT(K) CCCC 2526 FORMAT(/' AT 2526--K,CCALL(K),XDATA(K),DATA(K),', CCCC 1 'TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1),', CCCC 2 'QUALST(K),QUAL1,QUAL2,', CCCC 3 'JONE,JTWO,JTHREE,IPREX5,ICANADA', CCCC 5 'LTAGPT(K),NTAGPT(K)'/ CCCC 4 I8,2X,A8,8F8.2,7I4) CCCC ENDIF C IF(XDATA(K).GT.9998.5)THEN C REPLACEMENT IS NECESSARY. C C CHECK LEGITIMACY OF LNDSEA(K) AND SET INDEX KT FOR C KTLLB( , ). C KT=LNDSEA(K)/3+1 C IF(KT.LT.1.OR.KT.GT.4)THEN GO TO 253 C THIS STATION IS NOT USED. VALUE OF LNDSEA( ) NOT C LEGITIMATE. A DIAGNOSTIC HAS BEEN PRINTED AT 1018. ENDIF C IF(JTWO.EQ.2.OR.JTWO.EQ.4.OR.JTHREE.EQ.2)THEN C 2ND/3RD LEVEL COMPLETED BUT MAY HAVE HAD FEW OBS. C D WRITE(KFILDO,9256)QUAL1,QUAL2,JONE,JTWO,JTHREE,IPREX5 D9256 FORMAT(/' AT 9256 ENTERING A LAMP ONLY LOOP--', D 1 'QUAL1,QUAL2,JONE,JTWO,JTHREE,IPREX5',2F8.3,4I4) C IF(TEMP(K,1,1).LT.9998.5.AND.TEMP(K,2,1).LT.9998.5)THEN C BOTH 1ST AND 2ND LEVELS DATA ARE GOOD. C IF(IPREX5.EQ.1)THEN C IPREX5 INDICATES AVERAGING IS TO BE DONE. C SUMQQ=QUAL1+QUAL2 C INITIALLY, SUM OF QUAL1 AND QUAL2 = 1. IN CASE ONE C OR THE OTHER WAS CHANGED, DIVIDE DIVIDE C BY SUM WHEN MOS AND OBS ARE WEIGHTED. C XDATA(K)=(TEMP(K,1,1)*QUAL1+TEMP(K,2,1)*QUAL2)/SUMQQ LTAG(K)=0 C THIS STATEMENT MAKES NO DIFFERENCE FOR OBS C ANALYSIS TEMP/DP OR WIND SUITE. C IF(L.LE.5)THEN QUALST(K)=QUALST(K) C WHEN THE WEIGHTED AVERAGE IS COMPUTED, THE C TOTAL WEIGHT IS 1.*QUALST(K). ENDIF C NTAGPT(K)=1 KTLLB(KT,1)=KTLLB(KT,1)+1 C C ALTHOUGH THE 2ND OR 3RD LEVEL WAS USED, BECAUSE C IT WAS AVERAGED WITH LEVEL 1, IT IS NOT COUNTED, C IN KTLLB( , ) BECAUSE IT WOULD BE DUPLICATE C COUNTING. RATHER THE DUPLICATE POINTS ARE C COUNTED IN KTAVG( , ). C IF(TEMP(K,3,1).EQ.8888.)THEN KTAVG(KT,3)=KTAVG(KT,3)+1 C BOTH LEVELS 1 AND 3 WERE USED. ELSE KTAVG(KT,2)=KTAVG(KT,2)+1 C BOTH LEVELS 1 AND 2 WERE USED. ENDIF C ELSE C BOTH LEVELS OF DATA ARE GOOD, BUT BOTH LEVELS C ARE NOT TO BE USED, BUT ONLY THE FIRST. XDATA(K)=TEMP(K,1,1) LTAG(K)=0 C THIS STATEMENT MAKES NO DIFFERENCE FOR OBS C ANALYSIS TEMP/DP OR WIND SUITE. NTAGPT(K)=4 KTLLB(KT,1)=KTLLB(KT,1)+1 C IF(JTWO.EQ.2)THEN C IF(L.LE.5.AND.LNDSEA(K).LE.6)THEN C THIS IS LAMP AND A WATER STATION. THE FIRST C AUGMENTATION IS MOS AND MUST BE USED FULL C STRENGTH, SUBJECT TO THE DICTIONARY VALUE. C FOR OBS, MOS IS USED OVER WATER, AND MUST C HAVE FULL STRENGTH IN LAMP, OR THERE WILL C BE A CHANGE FROM OBS ANALYSIS TO LAMP. QUALST(K)=QUALST(K) ELSE QUALST(K)=QUALST(K)*QUAL1 C THIS IS THE SITUATION WHEN 1ST AND 2ND LEVELS C (MOS AND OBS FOR LAMP) ARE NOT AVERAGED. ENDIF C ELSE C IF(L.LE.5)THEN QUALST(K)=1. C IT IS KNOWN FROM ABOVE THAT JWO = 2 OR 4. C THIS IS THE SITUATION (JTWO = 4)WHEN THERE C ARE NOT ENOUGH OBSERVATIONS (ACCORDING C TO NUMOBS) AND MOS IS GIVEN THE WEIGHT = 1. ENDIF C ENDIF C ENDIF C ELSE C EITHER 1ST OR 2ND LEVEL IS MISSING. IF THE C 1ST LEVEL DIDN'T COMPLETE (JONE NE 2), THE C WEIGHT FOR LEVEL 2 SHOULD REMAIN. (FOR LAMP, C THESE ARE OBS, AND MUST FADE WITH PROJECTION.) IF(TEMP(K,1,1).LT.9998.5)THEN C IF(IPREX5.EQ.2.AND.LNDSEA(K).EQ.9.AND.ICANADA.EQ.0) 1 THEN XDATA(K)=9999. C THE 1ST LEVEL IS NOT USED IF 2ND LEVEL IS C MISSING FOR CONUS LAND. THIS IS FOR LAMP. THERE C ARE MANY MOS FORECASTS THAT DO NOT HAVE OBS, C AND CAUSE A DISCONTINUITY BETWEEN OBS ANALYSIS C AND LAMP PROJECTIONS. MOS WAS USED IN C THE ANALYSIS OVER WATER AND CANADA AND IS C CONTINUED. ELSE XDATA(K)=TEMP(K,1,1) LTAG(K)=0 C THIS STATEMENT MAKES NO DIFFERENCE FOR OBS C ANALYSIS TEMP/DP OR WIND SUITE. NTAGPT(K)=2 KTLLB(KT,1)=KTLLB(KT,1)+1 C CCCC WRITE(KFILDO,2528)K,CCALL(K),LNDSEA(K),QUALST(K), CCCC 1 KTLLB(KT,1) CCCC 2528 FORMAT(' AT 2528--K,CCALL(K),LNDSEA(K),QUALST(K),', CCCC 1 'KTLLB(KT,1) ',I8,2X,A8,I3,F6.3,I7) C IF(JTWO.EQ.2)THEN C IF(L.LE.5.AND.LNDSEA(K).LE.6)THEN C THIS IS LAMP AND A WATER STATION. THE FIRST C AUGMENTATION IS MOS AND MUST BE USED FULL C STRENGTH, SUBJECT TO THE DICTIONARY VALUE. C FOR OBS, MOS IS USED OVER WATER, AND MUST C HAVE FULL STRENGTH IN LAMP, OR THERE WILL C BE A CHANGE FROM OBS ANALYSIS TO LAMP. QUALST(K)=QUALST(K) ELSE QUALST(K)=QUALST(K)*QUAL1 C THIS DECREASES THE WEIGHT TO QUAL1 C ELSE QUALST( ) IS LEFT INTACT. ENDIF C ELSE C IF(L.LE.5)THEN QUALST(K)=1. C IT IS KNOWN FROM ABOVE THAT JWO = 2 OR 4. C THIS IS THE SITUATION (JTWO = 4)WHEN THERE C ARE NOT ENOUGH OBSERVATIONS (ACCORDING C TO NUMOBS) AND MOS IS GIVEN THE WEIGHT = 1. ENDIF C ENDIF C ENDIF C ELSEIF(TEMP(K,2,1).LT.9998.5)THEN XDATA(K)=TEMP(K,2,1) LTAG(K)=0 C THIS STATEMENT MAKES NO DIFFERENCE FOR OBS C ANALYSIS TEMP/DP OR WIND SUITE. NTAGPT(K)=3 C IF(TEMP(K,3,1).EQ.8888.)THEN KTLLB(KT,3)=KTLLB(KT,3)+1 ELSE KTLLB(KT,2)=KTLLB(KT,2)+1 ENDIF C QUALST(K)=QUALST(K)*QUAL2 C THIS IS THE 2ND LEVEL (OBS FOR LAMP) AND FOR LAMP MUST C FADE WITH PROJECTION. ENDIF C ENDIF C ELSE C LEVEL 2 WAS NOT DONE OR DID NOT COMPLETE SUCCESSFULLY. C FOR LAMP, THERE ARE NO OBS, SO ALL AUGMENTATION VALUES C ARE MOS. THEY WILL HAVE THE WEIGHT 1. C IF(TEMP(K,1,1).LT.9998.5)THEN XDATA(K)=TEMP(K,1,1) LTAG(K)=0 C THIS STATEMENT MAKES NO DIFFERENCE FOR OBS C ANALYSIS TEMP/DP OR WIND SUITE. C IF(L.LE.5)THEN QUALST(K)=1. ENDIF C NTAGPT(K)=2 KTLLB(KT,1)=KTLLB(KT,1)+1 C QUALST(K) IS LEFT INTACT AT DICTIONARY VALUE C (USUALLY = 1.) ENDIF C ENDIF C ENDIF C IF(CCALL(K).EQ.'DUMMY ')THEN WRITE(KFILDO,2529)K,CCALL(K),XDATA(K),DATA(K),SDATA(K), 1 TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1), 2 QUALST(K),QUAL1,QUAL2,IREPL(1),IREPL(2), 3 JONE,JTWO,JTHREE,IPREX5,ICANADA,LTAG(K), 4 LTAGPT(K),NTAGPT(K) 2529 FORMAT(/' AT 2529--K,CCALL(K),XDATA(K),DATA(K),SDATA(K)', 1 'TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1),', 2 'QUALST(K),QUAL1,QUAL2,IREPL(1),IREPL(2),', 3 'JONE,JTWO,JTHREE,IPREX5,ICANADA,LTAG(K)', 5 'LTAGPT(K),NTAGPT(K)'/ 4 I8,2X,A8,9F8.2,6I4,4I2) ENDIF C 253 CONTINUE C IF(JFIRST.NE.0)THEN WRITE(KFILDO,2530)JFIRST 2530 FORMAT(/' THERE WERE',I6,' CASES IN WHICH A STATION IN THE', 1 ' ANALYSIS LIST WAS NOT IN AUGMENTATION LIST.', 2 ' LOOK AT HOW U179 WAS RUN.') ENDIF C 2531 CONTINUE C THIS CONTINUE IS FOR TRANSFER TO SKIP DO 253 LOOP. C C BECAUSE OF PRINT, THE 4TH AUGMENTATION COLUMN IN KTLLB( , ) C IS INCLUDED WITH THE 3RD. MOST ANALYSES WILL NOT HAVE C A 4TH LEVEL, AND FOR LAMP TW IS TREATED AS BACKUP TO LEVEL 3. C DO 9531 M=1,5 KTLLB(M,3)=kTLLB(M,3)+KTLLB(M,4) 9531 CONTINUE C C NOW COMPUTE THE COLUMN AND ROW TOTALS. COLUMN 4, C THE BASE DATA, HAS ALREADY BEEN FILLED IN. C DO 2533 LL=1,5 DO 2532 M=1,4 KTLLB(5,LL)=KTLLB(5,LL)+KTLLB(M,LL) 2532 CONTINUE 2533 CONTINUE C IF(L.EQ.19.OR.L.EQ.20)THEN C C THE TOTAL FOR TOTAL WIND DOES NOT INCLUDE THE BASE, BECAUSE C THE "AUGMENTING VALUES" (THE GUSTS) ARE NOT EXTRA, BUT ADDED C TO THE SPEED. C DO 2535 M=1,5 DO 2534 LL=1,3 KTLLB(M,6)=KTLLB(M,6)+KTLLB(M,LL) 2534 CONTINUE 2535 CONTINUE C NGRAND=KTLLB(5,5) C FOR TOTAL WIND THE "GRAND TOTAL" PRINTED IS JUST THE C BASE DATA. C ELSE C C FOR MOST VARIABLES, THE TOTAL INCLUDES THE BASE, BECAUSE C THE AUGMENTING VALUES ARE EXTRA. C DO 2537 M=1,5 DO 2536 LL=1,5 KTLLB(M,6)=KTLLB(M,6)+KTLLB(M,LL) 2536 CONTINUE 2537 CONTINUE C NGRAND=KTLLB(5,6) C KTLLB(5,5) CONTAINS THE TOTAL DATA USED, INCLUDING C BASE DATA, EXCEPT FOR TOTAL WIND. ENDIF C C SET ANY NEGATIVE WIND SPEEDS (BECAUSE OF AUGMENTATION) TO ZERO. C THIS IS A SAFETY FOR TOTAL WIND, BECAUSE IT SHOULD NOT BE < 0. C IF(L.EQ.3.OR.L.EQ.16.OR.L.EQ.19.OR.L.EQ.20)THEN C DO 2538 K=1,NSTA C IF(XDATA(K).LT.0.)THEN XDATA(K)=0. ENDIF C 2538 CONTINUE C ENDIF C C IF THE QUALITY WEIGHT IS VERY SMALL, SET THE DATUM TO C MISSING FOR LAND STATIONS SO IT WON'T BE COUNTED ERROR C CHECKED. THE .001 ALLOWS FOR THE WEIGHTS FOR LARGER C PROJECTONS BEING SET VERY SMALL. A WATER OR LAKE/LAND C STATION IS ALLOWED EVEN WITH LOW WEIGHT. C DO 254 K=1,NSTA C CCCC IF(LNDSEA(K).LE.6)THEN CCCC WRITE(KFILDO,2539)CCALL(K),QUALST(K),LNDSEA(K),XDATA(K), CCCC 1 TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1) CCCC 2539 FORMAT(' AT 2539 IN AUGMT2--CCALL(K),QUALST(K),LNDSEA(K)', CCCC 1 'TEMP(K,1,1),TEMP(K,2,1),TEMP(K,3,1)', CCCC 1 2X,A8,F8.5,I4,4F8.1)) CCCC ENDIF C IF(QUALST(K).LT..001.AND.LNDSEA(K).EQ.9)THEN XDATA(K)=9999. ENDIF C 254 CONTINUE C WRITE(KFILDO,255)RLIMIT,MESHB, 1 (KTLLB(M,5),M=1,5), 2 ((KTLLB(M,LL),LL=1,3),KTLLB(M,6),M=1,4), 3 (KTLLB(5,LL),LL=1,3),KTLLB(5,6), 4 NGRAND 255 FORMAT(/' STATION COUNT BELOW LIMITED TO',F7.1, 1 ' GRIDLENGTHS OUTSIDE OF THE GRID AT NOMINAL', 2 ' GRIDLENGTH =',I3,' KM',/,/, 3 ' BASE OCEAN STATIONS WITH DATA =',I7,/, 4 ' INLAND WATER STATIONS " =',I7,/, 5 ' INLAND WATER/LAND STATIONS " =',I7,/, 6 ' LAND STATIONS " =',I7,/, X ' TOTAL STATIONS " =',I7,/, 7 ' OCEAN WATER STATIONS REPLACED ON FIRST', 8 ' AUGMENTATION PASS = ',I5,', ON SECOND PASS = ',I5, 9 ' ON THIRD PASS = ',I5, X ' TOTAL = ',I5,/, A ' INLAND WATER STATIONS REPLACED ON FIRST', B ' AUGMENTATION PASS = ',I5,', ON SECOND PASS = ',I5, C ' ON THIRD PASS = ',I5, X ' TOTAL = ',I5,/, D ' INLAND WATER/LAND STATIONS REPLACED ON FIRST', E ' AUGMENTATION PASS = ',I5,', ON SECOND PASS = ',I5, F ' ON THIRD PASS = ',I5, X ' TOTAL = ',I5,/, G ' LAND STATIONS REPLACED ON FIRST', H ' AUGMENTATION PASS = ',I5,', ON SECOND PASS = ',I5, I ' ON THIRD PASS = ',I5, X ' TOTAL = ',I5,/, X ' TOTALS',64X, I5,', ON SECOND PASS = ',I5, I ' ON THIRD PASS = ',I5, X ' TOTAL = ',I5,/, X 116X, ' GRAND TOTAL = ',I5) WRITE(KFILDO,256) 256 FORMAT(' TOTALS INCLUDE BASE AND AUGMENTATION DATA, EXCEPT', 1 ' FOR TOTAL WIND THE TOTAL IS THE BASE DATA TOTAL,', 2 ' WHICH IS THE FULLY AUGMENTED SPEED.'/ 3 ' TOTALS DO NOT INCLUDE ANY BOGUS POINTS THAT MAY', 4 ' BE ADDED LATER. THEY WILL BE COMBINATIONS OF', 5 ' POINTS COUNTED ABOVE.',/, 6 ' TOTALS DO INCLUDE STATIONS THAT MAY NOT BE USED', 7 ' BECAUSE OF BEING TOSSED UPSTREAM.') C IF(NUMAUG.EQ.4.AND.L.EQ.20)THEN WRITE(KFILDO,257)(KTLLB(5,3)-KTLLB(5,4)),KTLLB(5,4) 257 FORMAT(' THE 4TH LEVEL FOR TW IS COMBINED WITH THE 3RD.', 1 ' TOTAL NUMBERS OF 3RD AND 4TH LEVEL VALUES ARE',I6, 2 ' AND',I6,', RESPECTIVELY.') ENDIF C IF(L.EQ.19.OR.L.EQ.20)THEN WRITE(KFILDO,258) 258 FORMAT(' THE AUGMENTATION TOTALS FOR TOTAL WIND INCLUDE', 1 ' WHEN A LAMP OR A MOS GUST FORECAST WAS ZERO,', 2 ' INDICATING NO GUST.') ENDIF C DO 260 M=1,4 DO 259 LL=2,4 IF(KTAVG(M,LL).GT.0)GO TO 265 259 CONTINUE 260 CONTINUE C GO TO 280 C THERE WERE NO AVERAGED FORECASTS. C C NOW COMPUTE THE COLUMN AND ROW TOTALS OF KTAVG( , ). C BASE DATA (COLUMN 4) ARE NOT ADDED (ARE ZERO). C 265 DO 270 LL=1,4 DO 269 M=1,4 KTAVG(5,LL)=KTAVG(5,LL)+KTAVG(M,LL) 269 CONTINUE 270 CONTINUE C DO 273 M=1,5 DO 272 LL=1,4 KTAVG(M,6)=KTAVG(M,6)+KTAVG(M,LL) 272 CONTINUE 273 CONTINUE C 275 IF(L.LE.5)THEN WRITE(KFILDO,276) 276 FORMAT(/' IN ADDITION TO THE ABOVE, THE FOLLOWING WERE', 1 ' AVERAGED WITH AUGMENTATION PASS 1.') ELSEIF(L.EQ.20)THEN WRITE(KFILDO,2760) 2760 FORMAT(/' IN ADDITION TO THE ABOVE, WHERE THE COUNTS ARE', 1 ' AT THE HIGHEST AUGMENTATION LEVEL,THE FOLLOWING', 2 ' WERE AVERAGED WITH AUGMENTATION LEVEL=PASS') ENDIF C WRITE(KFILDO,277)((KTAVG(M,LL),LL=2,3),KTAVG(M,6),M=1,4), 1 (KTAVG(5,LL),LL=2,3),KTAVG(5,6) 277 FORMAT(/' OCEAN WATER STATIONS AVERAGED WITH FIR', 1 'ST AUGMENTATION PASS ON SECOND PASS = ',I5, 2 ' ON THIRD PASS = ',I5, 3 ' TOTAL = ',I5,/, 4 ' INLAND WATER STATIONS AVERAGED WITH FIR', 5 'ST AUGMENTATION PASS ON SECOND PASS = ',I5, 6 ' ON THIRD PASS = ',I5, 7 ' TOTAL = ',I5,/, 8 ' INLAND WATER/LAND STATIONS AVERAGED WITH FIR', 9 'ST AUGMENTATION PASS ON SECOND PASS = ',I5, A ' ON THIRD PASS = ',I5, B ' TOTAL = ',I5,/, C ' LAND STATIONS AVERAGED WITH FIR', D 'ST AUGMENTATION PASS ON SECOND PASS = ',I5, E ' ON THIRD PASS = ',I5, F ' TOTAL = ',I5,/, G ' TOTALS',70X, ' ON SECOND PASS = ',I5, H ' ON THIRD PASS = ',I5, I ' TOTAL = ',I5) C 280 WRITE(KFILDO,281)QUAL1,QUAL2,QUAL2 281 FORMAT(/' WEIGHTS IN ANALYSIS SANS DICTIONARY ON FIRST', 1 ' AUGMENTATION PASS = ',F6.3, 2 ', ON SECOND PASS = ',F6.3,' ON THIRD PASS = ',F6.3/) C IF(L.EQ.3)THEN C C SAVE LTAGPT( ) FOR WIND SPEED IN MTAGPT( ) FOR USE IN C TOTAL WIND. C DO 285 K=1,NSTA MTAGPT(K)=LTAGPT(K) IF(XDATA(K).GT.9998.5)MTAGPT(K)=4 285 CONTINUE C ENDIF C 900 CONTINUE C CCCC WRITE(KFILDO,905)(K,CCALL(K),NAME(K),(TEMP(K,L1),L1=1,3,1), CCCC 1 LTAGPT(K),XDATA(K),QUALST(K),LNDSEA(K), CCCC 2 NTAGPT(K),K=1,NSTA) CCCC 905 FORMAT(/'AT 905--K,CCALL(K),NAME(K),(TEMPK,L1,1),L1=1,3),', CCCC 1 'LTAGPT(K),XDATA(K),QUALST(K),LNDSEA(K),NTAGPT(K),', CCCC 2 'K=1NSTA)', CCCC 3 /(I6,2X,A8,2X,A20,3F8.1,I6,F8.1,F6.3,2I3)) C D KTEST=0 C D DO 906 K=1,NSTA C D IF(XPL(K).GE.RMINXY.AND.YPL(K).GE.RMINXY.AND. D 1 XPL(K).LE.RMAXX.AND.YPL(K).LE.RMAXY)THEN D IF(XDATA(K).LT.9998.5)KTEST=KTEST+1 D ENDIF C 906 CONTINUE C D WRITE(KFILDO,907)KTEST D907 FORMAT(/' TEST COUNT =',I7) C CCCC IF(L.LE.5)THEN CCCC WRITE(KFILDO,908)(K,CCALL(K),(DIAG(K,J),J=1,5), CCCC 1 (TEMP(K,J,1),J=1,4),XDATA(K), CCCC 2 LNDSEA(K),QUALST(K),K=1,NSTA) CCCC 908 FORMAT(/'AT 908 IN AUGMT2--(K,CCALL(K),(DIAG(K,J),J=1,5),', CCCC 1 '(TEMP(K,J,1),J=1,4),XDATA(K),', CCCC 2 'LNDSEA(K),QUALST(K),K=1,NSTA)'/ CCCC 3 (I6,2X,A8,F12.1,2X,4F10.1,2X,4F10.1,F12.1,I3,F8.3)) CCCC ENDIF C C IF IER NE 0, IT IS RETURNED. OTHERWISE, IF KER NE 0, A MORE C MINOR ERROR OCCURRED, AND IER = 666 IS RETURNED. C 909 IF(IER.EQ.0)THEN C IF(NER.EQ.1)THEN IER=666 C NER = 1 WHEN ONE OR MORE AUGMENTING VARIABLES COULD C NOT BE FOUND. WHILE THIS IS MAJOR, COUNT IT MINOR C HERE SO THAT U405 CAN FINISH ANYWAY. ELSEIF(KER.EQ.1)THEN IER=666 C KER = 1 WHEN PREVIOUSLY TOSSED DATA COULD NOT BE C RETRIEVED FROM INTERNAL STORAGE. ENDIF C ENDIF C CCCC WRITE(KFILDO,9095)IER CCCC 9095 FORMAT(/' LEAVING AUGMT2 WITH IER =',I6) C CALL TIMPR(KFILDO,KFILDO,'END AUGMT2 ') C RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 910 CALL IERX(KFILDO,KFILDO,IOS,'AUGMT2',STATE) CALL W3TAGE('AUGMT2') STOP 9999 END