PROGRAM LT2UT LOGICAL ERRFLG INTEGER ERRCOD CHARACTER*3 STACOD INTEGER BYEAR INTEGER EYEAR CHARACTER*1 ANSWER(3) CHARACTER*60 INDRIV CHARACTER*60 OUDRIV CHARACTER*60 OHDRIV CHARACTER*20 LTFILE CHARACTER*80 COMNAM CHARACTER*1 ANS LOGICAL ANSSET LOGICAL ANSWSET ANS = ' ' ANSSET = .FALSE. ANSWSET = .FALSE. DO 10, I = 1, 3 ANSWER(I) = ' ' 10 CONTINUE CALL INITDR( INDRIV ) CALL INITDR( OUDRIV ) CALL INITDR( OHDRIV ) C........................................................................ C SOURCE AND DESTINATION DRIVES OF FILES . C........................................................................ WRITE( *,* ) ' Enter in the source drive (i.e. V:)' READ( *,'(A)' ) INDRIV WRITE( *,* ) WRITE( *,* ) ' Enter in the destination drive (i.e. G:)' READ( *,'(A)' ) OUDRIV WRITE( *,* ) WRITE( *,'(A,A)' ) ' Enter in the drive where the', + ' OU_HEADERS.OK file resides (i.e. C:)' READ( *,'(A)' ) OHDRIV WRITE( *,* ) C........................................................................ C CREATE A FILE THAT WILL CONTAIN THE LT TO UT SHIFT FOR EACH . C MONTH . C........................................................................ WRITE( LTFILE,1020 ) CALL CONCAT(OUDRIV,LTFILE,COMNAM) OPEN( 14,FILE=COMNAM,FORM='FORMATTED',STATUS='UNKNOWN', + ERR=999 ) C........................................................................ C THREE LETTER STATION CODE . C........................................................................ WRITE(*,*) ' Enter in the 3 letter station code' READ( *,'(A3)' ) STACOD WRITE(*,*) C........................................................................ C START YEAR . C........................................................................ WRITE(*,*) ' Enter in the start year' READ( *,* ) BYEAR IF( BYEAR .GE. 1900 ) BYEAR = BYEAR - 1900 WRITE(*,*) C........................................................................ C END YEAR . C........................................................................ WRITE(*,*) ' Enter in the end year' READ( *,* ) EYEAR IF( EYEAR .GE. 1900 ) EYEAR = EYEAR - 1900 WRITE(*,*) ' Reading and processing data...' C........................................................................ C SHIFT DATA . C........................................................................ DO 100, IYEAR = BYEAR, EYEAR CALL DATAIN( STACOD,IYEAR,ANSWER,INDRIV,OUDRIV,OHDRIV, + ERRFLG,ERRCOD,ANS,ANSSET,ANSWSET ) IF( ERRFLG ) THEN IF( ERRCOD .EQ. 1 ) THEN DO 20, J = 1, 3 ANSWER(J) = ' ' 20 CONTINUE WRITE(*,1000) IYEAR WRITE(14,1000) IYEAR ELSEIF( ERRCOD .EQ. 2 ) THEN CALL QPROG ELSEIF( ERRCOD .EQ. 3 ) THEN CALL QPROG ELSEIF( ERRCOD .EQ. 4 ) THEN CALL QPROG END IF ELSE WRITE(*,1010) IYEAR WRITE(14,1010) IYEAR END IF 100 CONTINUE CALL QPROG 999 WRITE( *,* ) ' ERROR... Opening the LT2UT.LOG file' 1000 FORMAT( ' Skipped year ',I2.2 ) 1010 FORMAT( ' Done with year ',I2.2 ) 1020 FORMAT( 'LT2UT.LOG' ) END C........................................................................... C . C Name: DATAIN . C . C Author: Chris Wells, Concurrent Software Inc. . C . C Abstract: This subroutine shifts data from LT to UT . C . C Algorithm: . C . C History: 24 June 1991 Todd Wilson LT to UT shift . C 25 Jan 1990 Ying Luan Documentation . C 14 Jan 1990 Chris Wells Complete code development . C 10 Jan 1990 Ying Luan Initial code development . C . C Input . C context: STCODE CHARACTER*3 3 letter station code . C IYEAR INTEGER Year index . C . C Output . C context: ERRFLG LOGICAL True if some type of error . C occurred . C ERRCOD INTEGER Denotes error type . C . C Referenced . C by: LT2UT . C . C References . C to: NXTDAY, PRVDAY, WRTHDR, FNDSFT, GETOVL, WRTDAT . C . C Notes: . C . C........................................................................... SUBROUTINE DATAIN( STCODE,IYEAR,ANSWER,INDRIV,OUDRIV,OHDRIV, + ERRFLG,ERRCOD,ANS,ANSSET,ANSWSET ) CHARACTER*3 STCODE INTEGER IYEAR CHARACTER*1 ANSWER(3) CHARACTER*60 INDRIV CHARACTER*60 OUDRIV CHARACTER*60 OHDRIV LOGICAL ERRFLG INTEGER ERRCOD CHARACTER*1 ANS LOGICAL ANSSET LOGICAL ANSWSET CHARACTER*5 STACOD INTEGER SYEAR INTEGER SMONTH CHARACTER*1 SHEMI INTEGER STIME INTEGER SDAY CHARACTER*5 LTVALS(31,0:23) CHARACTER*5 UTVALS(31,0:23) INTEGER SCHAR INTEGER Y,M,D,UT,LT,TZ LOGICAL FIRST INTEGER RECN INTEGER IREC INTEGER SHIFT CHARACTER*16 STNAME INTEGER COLAT INTEGER LON INTEGER SCOLAT INTEGER SLON CHARACTER*20 INFILE CHARACTER*20 OUFILE CHARACTER*20 OHFILE CHARACTER*80 COMNAM INTEGER NDAYS EXTERNAL NDAYS C......................................................................... C OPEN FILE OF LT DATA . C RECL=120 (ACCORDING TO MICROSOFT FORTRAN ALL RECORDS THAT ARE . C IN A FILE OPENED AS FORMATTED DIRECT ACCESS END WITH . C CARRIAGE RETURN AND A LINE FEED, THEREFORE 120 IS . C 122) . C......................................................................... WRITE( INFILE,2000 ) STCODE, IYEAR CALL CONCAT(INDRIV,INFILE,COMNAM) OPEN( 10,FILE=COMNAM,FORM='FORMATTED',STATUS='OLD', + ACCESS='DIRECT',RECL=120,ERR=997 ) C....................................................................... C OPEN FILE FOR THE UT DATA . C....................................................................... WRITE( OUFILE,2001 ) STCODE,IYEAR CALL CONCAT(OUDRIV,OUFILE,COMNAM) OPEN( 12,FILE=COMNAM,FORM='FORMATTED',STATUS='UNKNOWN', + ERR=998 ) C....................................................................... C OPEN THE OU_HEADE.OK FILE . C....................................................................... WRITE( OHFILE,2002 ) CALL CONCAT(OHDRIV,OHFILE,COMNAM) OPEN( 11,FILE=COMNAM,STATUS='OLD',FORM='FORMATTED', + ERR=999 ) C........................................................................ C INITIALIZE VARIABLES . C........................................................................ FIRST = .TRUE. RECN = 0 IREC = 0 INEXT = IYEAR LMONTH = 0 C......................................................................... C READ NEW URSI HEADER RECORD . C......................................................................... 100 IREC = IREC + 1 READ( 10,1010,END=910,ERR=920,REC=IREC ) STACOD,STIME,SHEMI, + SCOLAT,SLON, + SYEAR,SMONTH,SCHAR IF( LMONTH .NE. SMONTH ) THEN IF( .NOT. ANSWSET ) THEN ANSWER(1) = ANSWER(2) ANSWER(2) = ANSWER(3) ANSWER(3) = ' ' END IF IF( .NOT. ANSSET ) ANS = ' ' END IF LMONTH = SMONTH C......................................................................... C GET OU_HEADER DATA . C......................................................................... CALL GETOUH( STACOD,SYEAR,SMONTH,STNAME,COLAT,LON,STIME, + SHEMI,ANSWER(2),ANSWSET ) IF( ANSWSET ) THEN ANSWER(1) = ANSWER(2) ANSWER(3) = ANSWER(2) END IF C......................................................................... C CHECK GEOGRAPHIC LOCATION . C......................................................................... IF( .NOT. ANSSET ) THEN CALL CHKLOC( SYEAR,SMONTH,STACOD,SCOLAT,SLON,COLAT,LON, + ANS,ANSSET ) END IF IF( ANS .EQ. 'U' ) THEN COLAT = SCOLAT LON = SLON END IF C......................................................................... C WRITE NEW URSI HEADER RECORD . C......................................................................... CALL WRTHDR( STNAME,COLAT,LON,STACOD,SYEAR,SMONTH,SCHAR ) C......................................................................... C DETERMINE THE DIRECTION OF THE TIME SHIFT . C......................................................................... CALL FNDSFT( STIME,SHEMI,SHIFT ) C......................................................................... C GET THE OVERLAP DATA . C......................................................................... CALL GETOVL( IOUNIT,RECN,FIRST,SYEAR,SMONTH,SCHAR, + STCODE,INEXT,SHIFT,ANSWER,UTVALS,INDRIV,ANSWSET ) C.................................................................... C READ A MONTH OF HOURLY DATA . C.................................................................... DO 200 SDAY = 1,31 IREC = IREC + 1 READ( 10,1020,END=920,ERR=920,REC=IREC ) + (LTVALS(SDAY,LT),LT=00,23) 200 CONTINUE C......................................................................... C SKIP THE MONTHLY SUMMARIES . C......................................................................... IREC = IREC + 8 C......................................................................... C DETERMINE THE SHIFT FROM LT TO UT . C......................................................................... TZ = STIME / 15 IF ( SHEMI.NE.'W' ) TZ = -TZ C......................................................................... C SAVE THE LT TO UT SHIFT . C......................................................................... WRITE( 14,1030 ) SYEAR,SMONTH,TZ C......................................................................... C CONVERT LOCAL DAY AND TIME TO UNIVERSAL DAY AND TIME . C......................................................................... DO 500 SDAY = 1,NDAYS(SMONTH,SYEAR) DO 400 LT = 00,23 Y = SYEAR M = SMONTH D = SDAY UT = LT + TZ IF ( UT.GE.24 ) THEN CALL NXTDAY( Y,M,D ) UT = UT - 24 ENDIF IF ( UT.LT.00 ) THEN CALL PRVDAY( Y,M,D ) UT = UT + 24 ENDIF IF ((Y.EQ.SYEAR).AND.(M.EQ.SMONTH)) + UTVALS(D,UT) = LTVALS(SDAY,LT) 400 CONTINUE 500 CONTINUE C...................................................................... C WRITE A MONTH OF HOURLY DATA AND SPACE FOR THE SUMMARY DATA . C...................................................................... CALL WRTDAT( UTVALS ) C......................................................................... C GO TO NEXT MONTH . C......................................................................... GOTO 100 C......................................................................... C END OF THE INPUT FILE . C......................................................................... 910 ERRFLG = .FALSE. ERRCOD = 0 CLOSE( 10 ) CLOSE( 11 ) CLOSE( 12 ) CLOSE( 13 ) RETURN C......................................................................... C ERROR : READ ERROR OR UNEXPECTED END-OF-FILE . C......................................................................... 920 WRITE(*,1040) INFILE WRITE(14,1040) INFILE ERRFLG = .TRUE. ERRCOD = 3 RETURN C......................................................................... C ERROR: OPENING THE INPUT FILE . C......................................................................... 997 WRITE(*,1050) COMNAM WRITE(14,1050) COMNAM ERRFLG = .TRUE. ERRCOD = 1 CLOSE( 10 ) CLOSE( 11 ) CLOSE( 12 ) CLOSE( 13 ) RETURN C......................................................................... C ERROR: OPENING THE OUTPUT FILE . C......................................................................... 998 WRITE(*,1060) COMNAM WRITE(14,1060) COMNAM ERRFLG = .TRUE. ERRCOD = 2 CLOSE( 10 ) CLOSE( 11 ) CLOSE( 12 ) CLOSE( 13 ) RETURN C......................................................................... C ERROR: OPENING THE OU_HEADE.OK FILE . C......................................................................... 999 WRITE(*,1070) COMNAM WRITE(14,1070) COMNAM ERRFLG = .TRUE. ERRCOD = 4 CLOSE( 10 ) CLOSE( 11 ) CLOSE( 12 ) CLOSE( 13 ) RETURN 1010 FORMAT( 20X,A5,I3.3,A1,I4.4,I4.4,I4.4,I2.2,I2.2,74X ) 1020 FORMAT( 24(A5) ) 1030 FORMAT( I4.4,1X,I2.2,' UT = LT',SP,I3.2 ) 1040 FORMAT( ' ERROR... Unexpected end of file ',A ) 1050 FORMAT( ' ERROR... Opening the INPUT file ',A ) 1060 FORMAT( ' ERROR... Opening the OUTPUT file ',A ) 1070 FORMAT( ' ERROR... Opening ',A ) 2000 FORMAT( A3,I2.2,'.NEW' ) 2001 FORMAT( A3,I2.2,'.NUT' ) 2002 FORMAT( 'OU_HEADE.OK' ) END C........................................................................... C . C Name: FNDSFT . C . C Author: Todd Wilson, Concurrent Software Inc. . C . C Abstract: Determines the LT to UT shift direction . C . C Algorithm: Determine which hemisphere the station is in . C Determine if the amount of shift is equal to or greater . C than one hour . C . C History: 24 June 1991 Todd Wilson Initial code development . C . C Input . C context: STIME INTEGER Standard time meridian off . C the station . C SHEMI CHARACTER*1 Hemisphere . C . C Output . C context: SHIFT INTEGER Shift indicator . C = -1 East to west shift . C = 1 West to east shift . C = 0 No shift . C . C Referenced . C by: DATAIN . C . C References . C to: . C . C Notes: . C . C........................................................................... SUBROUTINE FNDSFT( STIME,SHEMI,SHIFT ) INTEGER STIME CHARACTER*1 SHEMI INTEGER SHIFT IF( STIME .GE. 15 ) THEN IF( SHEMI .EQ. 'E' ) THEN SHIFT = -1 ELSE SHIFT = 1 END IF ELSE SHIFT = 0 END IF RETURN END C........................................................................... C . C Name: GETNXT . C . C Author: Todd Wilson, Concurrent Software Inc. . C . C Abstract: Opens the data file that should contain the overlap . C . C Algorithm: Open file based on the year index and station code . C . C History: 24 June 1991 Todd Wilson Initial code development . C . C Input . C context: STCODE CHARACTER*3 Station code . C INEXT INTEGER Year index . C SY INTEGER Current year being shifted . C . C Output . C context: IOUNIT INTEGER Unit number to use . C RECN INTEGER Record number . C = 1 successful opening . C . C Referenced . C by: . C . C References . C to: . C . C Notes: . C . C........................................................................... SUBROUTINE GETNXT( IOUNIT,STCODE,INEXT,SY,RECN,INDRIV ) INTEGER IOUNIT CHARACTER*3 STCODE INTEGER INEXT INTEGER SY INTEGER RECN CHARACTER*60 INDRIV CHARACTER*20 INFILE CHARACTER*80 COMNAM C................................................................... C PRINT NEED TO CORRECT FOR SOME VERY WEIRD RUN TIME ERRORS . C................................................................... PRINT * RECN = 0 CLOSE( 13 ) C......................................................................... C DETERMINE IF THE OVERLAP FILE IS THE CURRENT FILE BEING SHIFTED . C......................................................................... IF( INEXT .NE. (SY-1900) ) THEN IOUNIT = 13 C....................................................................... C OPEN FILE WHICH CONTAINS THE OVERLAP DATA . C RECL=120 (ACCORDING TO MICROSOFT FORTRAN ALL RECORDS THAT ARE . C IN A FILE OPENED AS FORMATTED DIRECT ACCESS END WITH . C CARRIAGE RETURN AND A LINE FEED, THEREFORE 120 IS . C 122) . C....................................................................... WRITE( INFILE,1000 ) STCODE, INEXT CALL CONCAT(INDRIV,INFILE,COMNAM) OPEN( IOUNIT,FILE=COMNAM,FORM='FORMATTED',ACCESS='DIRECT', + STATUS='OLD',RECL=120,ERR=999 ) ELSE IOUNIT = 10 END IF RECN = 1 RETURN 999 WRITE(14,1050) COMNAM RETURN 1050 FORMAT( ' WARNING... Could not open the overlap file ',A ) 1000 FORMAT( A3,I2.2,'.NEW' ) END C........................................................................... SUBROUTINE GETOUH( STACOD,SYEAR,SMONTH,STNAME,COLAT,LON,STIME, + SHEMI,ANS,ANSWSET ) CHARACTER*5 STACOD INTEGER SYEAR INTEGER SMONTH CHARACTER*16 STNAME INTEGER COLAT INTEGER LON INTEGER STIME CHARACTER*1 SHEMI CHARACTER*1 ANS LOGICAL ANSWSET CHARACTER*1 ANS2 INTEGER LAT CHARACTER*1 NSLAT INTEGER EWLON CHARACTER*5 OSTCOD INTEGER STARTY INTEGER STARTM INTEGER ENDY INTEGER ENDM REAL TIME REAL BTIME REAL ETIME INTEGER OUSTIM CHARACTER*4 STSTIM CHARACTER*1 OUHEMI 100 READ( 11,1000,ERR=900,END=200 ) STNAME,LAT,NSLAT,LON,EWLON, + STSTIM,OUHEMI,OSTCOD, + STARTY,STARTM,ENDY,ENDM IF( OSTCOD .EQ. STACOD ) THEN IF( ENDY .EQ. 0 ) ENDY = 99 IF( ENDM .EQ. 0 ) ENDM = 12 TIME = (SYEAR - 1900.)*100. + SMONTH BTIME = STARTY*100. + STARTM ETIME = ENDY*100. + ENDM IF( (TIME .GE. BTIME) .AND. (TIME .LE. ETIME) ) THEN IF( STSTIM .EQ. ' ' ) THEN WRITE(*,2000) WRITE(*,2001) WRITE(*,*)'* ERROR...' WRITE(*,*)'* OU_HEADERS.OK time zone is blank for' WRITE(*,2002) STACOD,SMONTH,SYEAR WRITE(14,*)'* ERROR...' WRITE(14,*)'* OU_HEADERS.OK time zone is blank for' WRITE(14,2002) STACOD,SMONTH,SYEAR CALL QPROG END IF READ(STSTIM,'(I4.4)') OUSTIM OUSTIM = OUSTIM / 10 IF( NSLAT .EQ. 'S' ) LAT = -LAT COLAT = 900 - LAT IF( EWLON .EQ. 'W' ) LON = 3600 - LON IF( ANS .EQ. ' ' ) THEN IF( (STIME .NE. OUSTIM) .OR. (SHEMI .NE. OUHEMI) ) THEN WRITE(*,2000) WRITE(*,2001) WRITE(*,*)'* WARNING...' WRITE(*,2003)' * The URSI time zone does not', + ' agree with the OU_HEADERS.OK time zone for' WRITE(*,2002) STACOD,SMONTH,SYEAR 105 WRITE(*,*)'*' WRITE(*,*)'* Enter which time zone to use' WRITE(*,2003)' * ( "U" for URSI, "O" for', + ' OU_HEADERS.OK, or "Q" to exit )' READ(*,'(A1)') ANS WRITE(14,*)'* WARNING...' WRITE(14,2003)' * The URSI time zone did not', + ' agree with the OU_HEADERS.OK time zone for' WRITE(14,2002) STACOD,SMONTH,SYEAR IF( (ANS .EQ. 'U') .OR. (ANS .EQ. 'u') ) THEN ANS = 'U' WRITE(14,'(A)') ' URSI time zone was chosen' ELSEIF( (ANS .EQ. 'O') .OR. (ANS .EQ. 'o') ) THEN ANS = 'O' WRITE(14,2003) ' OU_HEADERS.OK time zone', + ' was chosen' ELSEIF( (ANS .EQ. 'Q') .OR. (ANS .EQ. 'q') ) THEN CALL QPROG ELSE GOTO 105 END IF WRITE(*,*) 106 IF( ANS .EQ. 'O' ) THEN WRITE(*,*) ' Would you like the OU_HEADERS.OK file' ELSE WRITE(*,*) ' Would you like the URSI input file' END IF WRITE(*,*) ' to be used for the time zone' WRITE(*,*) ' for the rest of this program? (Y/N)' READ(*,'(A)') ANS2 IF( (ANS2 .EQ. 'Y') .OR. (ANS2 .EQ. 'y') ) THEN ANSWSET = .TRUE. ELSEIF( (ANS2 .EQ. 'N') .OR. (ANS2 .EQ. 'n') ) THEN ANSWSET = .FALSE. ELSE GOTO 106 END IF WRITE(*,2000) WRITE(*,*) ' Reading and processing data...' END IF END IF IF( ANS .EQ. 'O' ) THEN STIME = OUSTIM SHEMI = OUHEMI END IF REWIND( 11 ) RETURN END IF END IF GOTO 100 200 WRITE(*,1020) STACOD,SMONTH,SYEAR CALL QPROG 900 WRITE(*,1030) WRITE(14,1030) CALL QPROG 999 WRITE(*,1040) WRITE(14,1040) CALL QPROG 1000 FORMAT( 13X,A16,18X,I3.3,A1,I4.4,A1,13X,A4,A1,1X,A5,4(I2.2) ) 1020 FORMAT( 'ERROR... No valid header data for ', + A5,2X,I2.2,2X,I4.4 ) 1030 FORMAT( ' ERROR... Reading OU_HEADE.OK' ) 1040 FORMAT( ' ERROR... Trying to open OU_HEADE.OK' ) 2000 FORMAT( 25(/) ) 2001 FORMAT( 1X,78('*') ) 2002 FORMAT( 1X,'* ',A5,2X,I2.2,', ',I4.2 ) 2003 FORMAT( A,A ) END C........................................................................... C . C Name: GETOVL . C . C Author: Todd Wilson, Concurrent Software Inc. . C . C Abstract: Gets the overlap data for the month being shifted . C . C Algorithm: If this is the first time this subroutine is called for . C the current year then based on the time shift the overlap . C file is determined and opened, and then the record . C . C History: 24 June 1991 Todd Wilson Initial code development . C . C Input . C context: STCODE CHARACTER*3 Station code . C INEXT INTEGER Year index . C SY INTEGER Current year being shifted . C . C Output . C context: IOUNIT INTEGER Unit number to use . C RECN INTEGER Record number . C = 1 successful opening . C . C Referenced . C by: . C . C References . C to: . C . C Notes: . C . C........................................................................... SUBROUTINE GETOVL( IOUNIT,RECN,FIRST,SY,SM,C,STCODE,INEXT,SHIFT, + ANSWER,UTVALS,INDRIV,ANSWSET ) INTEGER IOUNIT INTEGER RECN LOGICAL FIRST INTEGER SY INTEGER SM CHARACTER*3 STCODE INTEGER C INTEGER INEXT INTEGER SHIFT CHARACTER*5 UTVALS(31,0:23) CHARACTER*1 ANSWER(3) CHARACTER*60 INDRIV LOGICAL ANSWSET INTEGER Y INTEGER M INTEGER D INTEGER SDAY INTEGER LT INTEGER UT CHARACTER*5 LTVALS(31,0:23) CHARACTER*5 STACOD INTEGER SYEAR INTEGER SMONTH CHARACTER*1 SHEMI INTEGER STIME INTEGER SCHAR CHARACTER*16 STNAME INTEGER COLAT INTEGER LON INTEGER NDAYS EXTERNAL NDAYS C......................................................................... C INITIALIZE UT VALUES . C......................................................................... DO 50 SDAY = 1,31 DO 75 LT = 00,23 UTVALS(SDAY,LT) = ' ' 75 CONTINUE 50 CONTINUE Y = SY M = SM IF( SHIFT .EQ. 0 ) THEN RETURN ELSEIF( SHIFT .GT. 0 ) THEN M = M - 1 IF( M .LE. 0 ) THEN M = 12 Y = Y - 1 END IF IA = 1 ELSE M = M + 1 IF( M .GT. 12 ) THEN M = 1 Y = Y + 1 END IF IA = 3 END IF IF( FIRST ) THEN FIRST = .FALSE. IF( (SHIFT .GT. 0) .AND. (M .EQ.12) ) INEXT = INEXT - 1 CALL GETNXT( IOUNIT,STCODE,INEXT,SY,RECN,INDRIV ) IF( RECN .NE. 1 ) THEN IF( SHIFT .GT. 0 ) INEXT = INEXT + 1 RETURN END IF ELSEIF( RECN .EQ. 0 ) THEN INEXT = INEXT + 1 CALL GETNXT( IOUNIT,STCODE,INEXT,SY,RECN,INDRIV ) IF( RECN .NE. 1 ) THEN INEXT = INEXT -1 RETURN END IF END IF C......................................................................... C READ NEW URSI HEADER RECORD . C......................................................................... 100 READ( IOUNIT,1010,END=910,ERR=920,REC=RECN ) STACOD,STIME,SHEMI, + SYEAR,SMONTH,SCHAR IF( (SYEAR.EQ.Y) .AND. (SMONTH.GT.M) .OR. (SYEAR.GT.Y) ) THEN RETURN ELSEIF( SYEAR .LT. Y ) THEN INEXT = INEXT + 1 CALL GETNXT( IOUNIT,STCODE,INEXT,SY,RECN,INDRIV ) IF( RECN .NE. 1 ) THEN INEXT = INEXT - 1 RETURN END IF ELSEIF( (SMONTH .LT. M).OR.(SCHAR.NE.C) ) THEN RECN = RECN + 40 ELSEIF( (SYEAR.EQ.Y).AND.(SMONTH.EQ.M).AND.(SCHAR.EQ.C) ) THEN C......................................................................... C GET OU_HEADER DATA . C......................................................................... CALL GETOUH( STACOD,SYEAR,SMONTH,STNAME,COLAT,LON,STIME, + SHEMI,ANSWER(IA),ANSWSET ) IF( ANSWSET ) THEN ANSWER(1) = ANSWER(IA) ANSWER(2) = ANSWER(IA) ANSWER(3) = ANSWER(IA) END IF C.................................................................... C READ A MONTH OF HOURLY DATA . C.................................................................... DO 200 SDAY = 1,31 RECN = RECN + 1 READ( IOUNIT,1020,END=920,ERR=920,REC=RECN ) + (LTVALS(SDAY,LT),LT=00,23) 200 CONTINUE RECN = RECN + 9 C......................................................................... C DECODE HEADER INFO . C......................................................................... TZ = STIME / 15 IF ( SHEMI.NE.'W' ) TZ = -TZ DO 500 SDAY = 1,NDAYS(SMONTH,SYEAR) DO 400 LT = 00,23 Y = SYEAR M = SMONTH D = SDAY UT = LT + TZ IF ( UT.GE.24 ) THEN CALL NXTDAY( Y,M,D ) UT = UT - 24 ENDIF IF ( UT.LT.00 ) THEN CALL PRVDAY( Y,M,D ) UT = UT + 24 ENDIF IF ((Y.EQ.SY).AND.(M.EQ.SM)) + UTVALS(D,UT) = LTVALS(SDAY,LT) 400 CONTINUE 500 CONTINUE RETURN END IF GOTO 100 RETURN 910 INEXT = INEXT + 1 CALL GETNXT( IOUNIT,STCODE,INEXT,SY,RECN,INDRIV ) IF( RECN .NE. 1 ) THEN INEXT = INEXT - 1 RETURN END IF GOTO 100 920 WRITE(*,1030) WRITE(14,1030) CALL QPROG 1000 FORMAT( A3,I2.2,'.NEW' ) 1010 FORMAT( 20X,A5,I3.3,A1,8X,I4.4,I2.2,I2.2,74X ) 1020 FORMAT( 24(A5) ) 1030 FORMAT( ' ERROR... Reading from the overlap file' ) END C........................................................................... C . C Name: NXTDAY . C . C Author: Chris Wells . C . C Abstract: This subroutine adjusts the date specified by year/month/ . C day to be its tomorrow. . C . C Algorithm: Add a day to date and adjust month and year for wrap . C . C History: 26 Jan 1990 Ying Luan Documentation . C 14 Jan 1990 Chris Wells Initial code development . C . C Input . C context: YEAR year . C MONTH month . C DAY day . C . C Output . C context: YEAR Adjusted year . C MONTH Adjusted month . C DAY Adjusted day . C . C Referenced . C by: QUIETQ, ISSTRM . C . C References . C to: NDAYS . C . C........................................................................... SUBROUTINE NXTDAY( YEAR,MONTH,DAY ) INTEGER YEAR INTEGER MONTH INTEGER DAY INTEGER NDAYS EXTERNAL NDAYS C........................................................................ C ADJUST THE DATE SPECIFIED BY YEAR/MONTH/DAY TO BE ITS TOMORROW . C........................................................................ DAY = DAY + 1 IF ( DAY.GT.NDAYS(MONTH,YEAR) ) THEN DAY = DAY - NDAYS(MONTH,YEAR) MONTH = MONTH + 1 IF ( MONTH.GT.12 ) THEN MONTH = MONTH - 12 YEAR = YEAR + 1 ENDIF ENDIF RETURN END C........................................................................... C . C Name: PRVDAY . C . C Author: Chris Wells . C . C Abstract: This subroutine adjusts the date specified by year/month/ . C day to be its yesterday . C . C Algorithm: Subtract a day to date and adjust month and year for wrap . C . C History: 26 Jan 1990 Ying Luan Documentation . C 14 Jan 1990 Chris Wells Initial code development . C . C Input . C context: YEAR year . C MONTH month . C DAY day . C . C Output . C context: YEAR Adjusted year . C MONTH Adjusted month . C DAY Adjusted day . C . C Referenced . C by: QUIETQ, ISSTRM . C . C References . C to: NDAYS . C . C........................................................................... SUBROUTINE PRVDAY( YEAR,MONTH,DAY ) INTEGER YEAR INTEGER MONTH INTEGER DAY INTEGER NDAYS EXTERNAL NDAYS C........................................................................ C ADJUST THE DATE SPECIFIED BY YEAR/MONTH/DAY TO BE ITS YESTERDAY . C........................................................................ DAY = DAY - 1 IF ( DAY.LT.1 ) THEN MONTH = MONTH - 1 IF ( MONTH.LT.1 ) THEN MONTH = MONTH + 12 YEAR = YEAR - 1 ENDIF DAY = DAY + NDAYS(MONTH,YEAR) ENDIF RETURN END C........................................................................... SUBROUTINE WRTDAT( UTVALS ) CHARACTER*5 UTVALS(31,0:23) INTEGER DAY INTEGER SUMMRY INTEGER LT C.................................................................... C WRITE A MONTH OF HOURLY DATA . C.................................................................... DO 100 DAY = 1,31 WRITE( 12,1020 ) (UTVALS(DAY,LT),LT=00,23) 100 CONTINUE C......................................................................... C SAVE AREA FOR MONTHLY SUMMARIES . C......................................................................... DO 200 SUMMRY = 1,8 WRITE( 12,1020 ) (' ',LT=00,23) 200 CONTINUE RETURN 1020 FORMAT( 24(A5) ) END C........................................................................... SUBROUTINE WRTHDR( STNAME,COLAT,LON,STACOD,Y,M,SCHAR ) CHARACTER*16 STNAME INTEGER COLAT INTEGER LON CHARACTER*5 STACOD INTEGER Y INTEGER M INTEGER SCHAR INTEGER STIME CHARACTER*1 SHEMI CHARACTER*75 FILL COMMON /FLBLK/ FILL STIME = 0 SHEMI = 'E' C................................................................ C WRITE NEW URSI HEADER RECORD . C................................................................ WRITE( 12,1010 ) STNAME,STACOD,STIME,SHEMI, + COLAT,LON,Y,M,SCHAR,FILL RETURN 1010 FORMAT( A16,4X,A5,I3.3,A1,I4.4,I4.4,I4.4,I2.2,I2.2,A75 ) END C....................................................................... C RETURNS THE NUMBER OF DAYS IN A SPECIFIED MONTH AND YEAR, TAKING . C LEAP YEAR INTO ACCOUNT . C....................................................................... INTEGER FUNCTION NDAYS( MONTH,YEAR ) INTEGER MONTH INTEGER YEAR INTEGER NOLEAP(12) DATA NOLEAP / 31,28,31,30,31,30,31,31,30,31,30,31 / IF ( (MONTH.EQ.2).AND. + (MOD(YEAR,4).EQ.0).AND.(MOD(YEAR,20).NE.0) ) THEN NDAYS = NOLEAP(MONTH) + 1 ELSE NDAYS = NOLEAP(MONTH) ENDIF RETURN END BLOCK DATA INTFIL CHARACTER*75 FILL COMMON /FLBLK/ FILL DATA FILL(1:10),FILL(11:20),FILL(21:30) /3*' '/ DATA FILL(31:40),FILL(41:50),FILL(51:60) /3*' '/ DATA FILL(61:75) /' '/ END SUBROUTINE INITDR( DRIVE ) CHARACTER*60 DRIVE DO 100, I = 1, 60 DRIVE(I:I) = ' ' 100 CONTINUE RETURN END SUBROUTINE CONCAT(DRIVE,FLNAME,COMNAM) CHARACTER*80 COMNAM CHARACTER*60 DRIVE CHARACTER*20 FLNAME DO 50, I = 1, 80 COMNAM(I:I) = ' ' 50 CONTINUE ILEN = 0 DO 100, I = 1, 60 IF( DRIVE(I:I) .EQ. ' ' ) GOTO 101 ILEN = ILEN + 1 100 CONTINUE 101 IF( (DRIVE(ILEN:ILEN) .NE. '\') .AND. + (DRIVE(ILEN:ILEN) .NE. ':') ) THEN ILEN = ILEN + 1 DRIVE(ILEN:ILEN) = '\' end if COMNAM = DRIVE(1:ILEN) // FLNAME RETURN END SUBROUTINE CHKLOC(SYEAR,SMONTH,STACOD,SCOLAT,SLON,COLAT,LON, + ANS,ANSSET) CHARACTER*5 STACOD INTEGER SYEAR INTEGER SMONTH INTEGER SCOLAT,SLON INTEGER COLAT,LON CHARACTER*1 ANS LOGICAL ANSSET CHARACTER*1 ANS2 INTEGER WFLAG WFLAG = 0 IF( ANS .EQ. ' ' ) THEN IF( (SCOLAT .GT. COLAT+1) .OR. + (SCOLAT .LT. COLAT-1) ) THEN WFLAG = 1 ELSEIF( (SLON .GT. LON+1) .OR. + (SLON .LT. LON-1) ) THEN WFLAG = 1 END IF IF( WFLAG .EQ. 1 ) THEN WRITE(*,2000) WRITE(*,2001) WRITE(*,*)'* WARNING...' WRITE(*,3003)' * The URSI geographic location', + ' does not agree with' WRITE(*,3003)' * the OU_HEADERS.OK geographic', + ' location for' WRITE(*,3002) STACOD,SMONTH,SYEAR 105 WRITE(*,*)'*' WRITE(*,*)'* Enter which geographic location to use' WRITE(*,3003)' * ( "U" for URSI, "O" for', + ' OU_HEADERS.OK, or "Q" to exit )' READ(*,'(A1)') ANS WRITE(14,*)'* WARNING...' WRITE(14,3003)' * The URSI geographic location', + ' did not agree with' WRITE(14,3003)' * the OU_HEADERS.OK geographic', + ' location for' WRITE(14,3002) STACOD,SMONTH,SYEAR IF( (ANS .EQ. 'U') .OR. (ANS .EQ. 'u') ) THEN ANS = 'U' WRITE(14,'(A)') ' URSI geographic location was chosen' ELSEIF( (ANS .EQ. 'O') .OR. (ANS .EQ. 'o') ) THEN ANS = 'O' WRITE(14,3003) ' OU_HEADERS.OK geographic location', + ' was chosen' ELSEIF( (ANS .EQ. 'Q') .OR. (ANS .EQ. 'q') ) THEN CALL QPROG ELSE GOTO 105 END IF WRITE(*,*) 106 IF( ANS .EQ. 'O' ) THEN WRITE(*,*) ' Would you like the OU_HEADERS.OK file ' ELSE WRITE(*,*) ' Would you like the URSI input file ' END IF WRITE(*,*) ' to be used for the geographic location ' WRITE(*,*) ' for the rest of this program? (Y/N)' READ(*,'(A)') ANS2 IF( (ANS2 .EQ. 'Y') .OR. (ANS2 .EQ. 'y') ) THEN ANSSET = .TRUE. ELSEIF( (ANS2 .EQ. 'N') .OR. (ANS2 .EQ. 'n') ) THEN ANSSET = .FALSE. ELSE GOTO 106 END IF END IF END IF RETURN 2000 FORMAT( 25(/) ) 2001 FORMAT( 1X,78('*') ) 3002 FORMAT( 1X,'* ',A5,2X,I2.2,', ',I4.2 ) 3003 FORMAT( A,A ) END SUBROUTINE QPROG CLOSE( 10 ) CLOSE( 11 ) CLOSE( 12 ) CLOSE( 13 ) CLOSE( 14 ) STOP RETURN END