IMPLICIT REAL*8(A-H,O-Z) DIMENSION L(12),M(12),A(12),B(130),BS(130) CHARACTER *5 X1,X2,X3,X4,Q,Q1 CHARACTER *1 S CHARACTER *8 A DATA L(1)/0/,L(2)/31/,L(3)/59/,L(4)/90/,L(5)/120/,L(6)/151/ DATA L(7)/181/,L(8)/212/,L(9)/243/,L(10)/273/,L(11)/304/ DATA L(12)/334/,M(1)/0/,M(2)/31/,M(3)/60/,M(4)/91/,M(5)/121/ DATA M(6)/152/,M(7)/182/,M(8)/213/,M(9)/244/,M(10)/274/,M(11)/305/ DATA M(12)/335/ DATA A/ 'JANUARY ','FEBRUARY',' MARCH ',' APRIL ',' MAY ', $ ' JUNE ',' JULY ', $ ' AUGUST ',' SEPT. ','OCTOBER ','NOVEMBER','DECEMBER'/ DATA X1/'NORTH'/,X2/'SOUTH'/,X3/'EAST '/,X4/'WEST '/ C DO 300 I=1,12 C READ 120,A(I) C 120 FORMAT(3X,A8) C 300 CONTINUE C READ 4,X1,X2,X3,X4 100 READ(5,1,END=101)J1,J2,J3,J4,J5,K1,N,J8,K2,N1,S,T0,B0,Y,Z,ZZ IF (S.EQ.'-') GO TO 111 GO TO 222 111 T0 = (-1.0) * T0 S = ' ' 222 DO 50 I=1,5 IF(J1.LT.0) Q=X2 IF(J1.GT.0) Q=X1 IF(I.EQ.5)GO TO 50 IF(J3.LT.0) Q1=X4 IF(J3.GT.0) Q1=X3 50 CONTINUE J101=IABS(J1) J103=IABS(J3) 1 FORMAT (I3,1X,I2,1X,I3,1X,I2,1X,I2,1X,I2,1X,I4,1X, 1I2,1X,I2,1X,I4,1X,A1,F4.1,1X,F5.3,1X,3A8) IF (B0.EQ.0) GO TO 101 P1=0.25*N-INT(0.25*N) IF (DABS(P1).LT.1.D-3)GO TO 11 IF (K1.EQ.K2) GO TO 30 I=K1 20 I1=L(I)+J5 IF (I1.GT.L(I+1)) GO TO 12 WRITE (6,3) WRITE(6,2) B0,J101,J2,Q,J103,J4,Q1,J5, * A(K1),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J5=J5+1 GO TO 20 12 I=K1+1 16 IF (I.EQ.K2) GO TO 13 J11=1 21 I1=L(I)+J11 IF (I1.GT.L(I+1)) GO TO 15 WRITE (6,3) WRITE(6,2) B0,J101,J2,Q,J103,J4,Q1,J11, * A(I),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J11=J11+1 GO TO 21 15 I=I+1 GO TO 16 13 J12=1 14 IF (J12.GT.J8) GO TO 100 I1=L(K2)+J12 WRITE (6,3) WRITE (6,2) B0,J101,J2,Q,J103,J4,Q1,J12, * A(K2),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J12=J12+1 GO TO 14 30 IF (J5.GT.J8) GO TO 100 I1=L(K1)+J5 WRITE (6,3) WRITE (6,2) B0,J101,J2,Q,J103,J4,Q1,J5, * A(K1),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J5=J5+1 GO TO 30 11 IF (K1.EQ.K2) GO TO 40 I=K1 31 I1=M(I)+J5 IF (I1.GT.M(I+1)) GO TO 32 WRITE (6,3) WRITE (6,2) B0,J101,J2,Q,J103,J4,Q1,J5, * A(K1),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J5=J5+1 GO TO 31 32 I=K1+1 37 IF (I.EQ.K2) GO TO 33 J11=1 34 I1=M(I)+J11 IF (I1.GT.M(I+1)) GO TO 35 WRITE (6,3) WRITE (6,2) B0,J101,J2,Q,J103,J4,Q1,J11, * A(I),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J11=J11+1 GO TO 34 35 I=I+1 GO TO 37 33 J12=1 36 IF (J12.GT.J8) GO TO 100 I1=M(K2)+J12 WRITE (6,3) WRITE (6,2) B0,J101,J2,Q,J103,J4,Q1,J12, * A(K2),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J12=J12+1 GO TO 36 40 IF (J5.GT.J8) GO TO 100 I1=M(K1)+J5 WRITE (6,3) WRITE (6,2) B0,J101,J2,Q,J103,J4,Q1,J5, * A(K1),N,S,T0,Y,Z,ZZ CALL SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) J5=J5+1 GO TO 40 2 FORMAT (1H ,42X, 1'T I D A L G R A V I T Y C O R R E C T I O N (MICROGALS)',//, 25X,'DELTA FACTOR = ', 2F5.3,/,5X,16HCOMPUTED AT LAT=,I3,1HD,1X,I2,1HM,1X,A5, 325X,11(1H*,1X),/,16X,5HLONG=,I3,1HD,1X,I2,1HM,1X,A5,25X, 41H*,1X,I2,1X, A8,1X,I4,2X,1H*,20X,'U.T.=LOCAL TIME ',A1,F5.2,1X, 55HHOURS,/,5X,13HSTATION NAME=,3A8,18X,11(1H*,1X),//,7X, 610HLOCAL TIME,/,8X,8HHOUR MIN,5X,9HMICROGALS, 714X,4H-200,6X,4H-150,6X,4H-100,6X,4H- 50,6X,4H 0.0,6X,4H+ 50, 86X,4H+100,6X,4H+150,6X,4H+200,/,34X,49(1H.,1X)) 3 FORMAT('1',4X,'UNIVERSITY OF NEW BRUNSWICK',/,5X, 1 'DEPT. OF SURVEYING ENGINEERING') C 4 FORMAT (2(5A1),2(4A1)) 101 STOP END SUBROUTINE SRLFE (J1,J2,J3,J4,N,I1,B0,I20,I21,DG,L,T0,D0,A,B,BS) IMPLICIT REAL*8(A-H,O-Z) REAL *8 AAA INTEGER KK DIMENSION A(12) LOGICAL*1 B(130),BS(130) CHARACTER *1 ST,CL DATA ST/'*'/,CL/' '/ D=0.0174532925D0 D0=57.29577951D0 B1=365.5+365*(N-1901)+INT(0.25*(N-1901))+I1-1 B10=B1+1 B2=B1/36525. B3=3.6525*B2 B20=B10/36525. B30=3.6525*B20 C1=279.696678D0+0.985647D0*B1+0.000023D0*(B3**2) D1=279.696678D0+0.985647D0*B10+0.000023D0*(B30**2) C2=281.220844D0+0.000047D0*B1 D2=281.220844D0+0.000047D0*B10 C3=270.434164D0+13.176396527D0*B1-0.000085D0*(B3**2) D3=270.434164D0+13.176396527D0*B10-0.000085D0*(B30**2) C4=334.329556D0+0.11140408D0*B1-0.000774D0*(B3**2) D4=334.329556D0+0.11140408D0*B10-0.000774D0*(B30**2) C5=259.183275D0-0.05295392D0*B1+0.000156D0*(B3**2) D5=259.183275D0-0.05295392D0*B10+0.000156D0*(B30**2) E0=23.452294D0-0.0035626D0*B3-0.0000000123D0*(B3**2) E01=23.452294D0-0.0035626D0*B30-0.0000000123D0*(B30**2) A1=D*(C1-C2) G1=D*(D1-D2) A2=D*(C3-C4) G2=D*(D3-D4) A3=D*(C3-2*C1+C4) G3=D*(D3-2*D1+D4) A4=D*(C3-C1) G4=D*(D3-D1) A5=D*(C3+2*C1+C4) G5=D*(D3+2*D1+D4) P0=C1+(0.034*DSIN(A1))*D0 P01=D1+(0.034*DSIN(G1))*D0 C7=P0-0.043D0*DSIN(2*P0*D)*D0 D7=P01-0.043*DSIN(2*P01*D)*D0 C8=DASIN(0.406*DSIN(D*C7)+0.008*DSIN(3*D*C7)) D8=DASIN(0.406*DSIN(D*D7)+0.008*DSIN(3*D*D7)) C90=1+0.055D0*DCOS(A2)+0.010D0*DCOS(A3) C91=0.008D0*DCOS(2*A4)+0.003D0*DCOS(2*A2) C9=C90+C91 D90=1+0.055D0*DCOS(G2)+0.010D0*DCOS(G3) D91=0.008D0*DCOS(2*G4)+0.003D0*DCOS(2*G2) D9=D90+D91 C101=C3+D0*(0.1108*DSIN(A2)+0.023*DSIN(A5)) C102=D0*(0.011*DSIN(2*A4)+0.004*DSIN(2*A2)) D101=D3+D0*(0.1108*DSIN(G2)+0.023*DSIN(G5)) D102=D0*(0.011*DSIN(2*G4)+0.004*DSIN(2*G2)) C10=C101+C102 D10=D101+D102 C111=C10+D0*(-0.043*DSIN(2*D*C3)+0.019*DSIN(D*C5)) C112=D0*(-0.019*DSIN(D*(2*C3-C5))) D111=D10+D0*(-0.043*DSIN(2*D*D3)+0.019*DSIN(D*D5)) D112=D0*(-0.019*DSIN(D*(2*D3-D5))) C11=C111+C112 D11=D111+D112 DS=7.4*DCOS(D*C5) DS1=7.4*DCOS(D*D5) ALAT=18520.D0*DSIN((C3-C5+DS)*D)-526.D0*DSIN((2*C1-C3-C5)*D) ALAT1=18520.D0*DSIN((D3-D5+DS1)*D)-526.D0*DSIN((2*D1-D3-D5)*D) C121=DCOS(ALAT*D/3600.D0)*DSIN(D*C3)*DSIN(D*E0) D121=DCOS(ALAT1*D/3600.D0)*DSIN(D*D3)*DSIN(D*E01) C122=DSIN(ALAT*D/3600.D0)*DCOS(D*E0) D122=DSIN(ALAT1*D/3600.D0)*DCOS(D*E01) C12=DASIN(C121+C122) D12=DASIN(D121+D122) C14=99.6909833D0+36000.76892D0*B2+3.870833D-4*(B2**2) D14=99.6909833D0+36000.76892D0*B20+3.870833D-4*(B20**2)+360 F=(IABS(J1)+J2/60.)*J1/IABS(J1) W=(IABS(J3)+J4/60.)*J3/IABS(J3) C15=C14+W-C11 D15=D14+W-D11 C16=C14+W-C7 D16=D14+W-D7 DC8=(D8-C8)/48 DC9=(D9-C9)/48 DC12=(D12-C12)/48 DC15=(D15-C15)/48 DC16=(D16-C16)/48 T=0. 10 I20=T I21=(T-I20)*60 C17=D0*DATAN(DTAN(C8+T0*2*DC8 )/DCOS(D*(C16+2*T0*DC16))) Z1=DSIN(C8+T0*2*DC8 )*DCOS(D*(F-C17))/DSIN(D*C17) Z21=DSIN(D*F)*DSIN(C12+2*T0*DC12) C152=C15+2*T0*DC15 Z22=DCOS(D*F)*DCOS(C12+2*T0*DC12)*DCOS((C152)*D) Z2=Z21+Z22 DG=B0*(0.165*(Z2*Z2-1/3.)*(C9+T0*2*DC9)**3.+0.075*(Z1*Z1-1/3.)) DG=DG*1000.0 WRITE (6,1) I20,I21,DG 1 FORMAT(9X,I2,2X,I2,6X,F8.3,17X,4(1H|,9X),1H0,4(9X,1H|)) AAA=DG/1000.0 KK=(AAA*200.+84.) WRITE (6,110) (B(I),I=1,KK),ST GO TO 12 110 FORMAT (1H+,130A1) 12 T=T+0.5 IF(T.GT.23.5) GO TO 11 C8=C8+DC8 C9=C9+DC9 C15=C15+DC15 C16=C16+DC16 C12=C12+DC12 GO TO 10 11 RETURN END