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