PROGRAM GENTIDE(INPUT,OUTPUT,PUNCH,TAPE5=INPUT) DIMENSION ASTRON(12,1000),TIDE(14,1000),IZ(110,24) COMMON ASTRON,TIDE XH=0.615 XL=0.084 1000 READ 300,IDAY1,IYEAR,IDAY2,KIND IF(EOF(5).NE.0.0) GO TO 777 READ 400,SLAT,SLONG,AZIM,SITE IF(EOF(5).NE.0.0) GO TO 777 IYEAR=IYEAR-1900 IHR=0 DELT=1.0 NDAYS=IDAY2-IDAY1+1 NCALC=NDAYS*24/DELT PRINT 31,IDAY1,IYEAR,IDAY2,SLAT,SLONG,AZIM CALL NOMAN1(IHR,IDAY1,IYEAR,NCALC,DELT) SH=0.0 IF(KIND.NE.4) XH=0.1 CALL NOMAN2(SLAT,SLONG,SH,KIND,AZIM,NCALC) DO 100 M=1,NDAYS DO 100 L=1,24 ML=(M-1)*24+L 100 IZ(M,L)=TIDE(14,ML)*XH*100. IF(KIND.EQ.4) KIND=3 IF(KIND.NE.3) XL=0.0 CALL NOMAN2(SLAT,SLONG,SH,KIND,AZIM,NCALC) DO 20 M=1,NDAYS JN=IDAY1+M-1 DO 200 L=1,24 ML=(M-1)*24+L 200 IZ(M,L)=IZ(M,L)+TIDE(14,ML)*XL*100. PRINT 30,JN,IYEAR,SITE,(IZ(M,L),L=1,12) PUNCH 40,JN,IYEAR,SITE,(IZ(M,L),L=1,12) PRINT 35,JN,KIND,(IZ(M,L),L=13,24) PUNCH 50,JN,KIND,(IZ(M,L),L=13,24) 30 FORMAT(1H0,I3,I2,A3,12I6) 31 FORMAT(1X,3I4,2F8.3,F6.0) 40 FORMAT(I3,I2,A3,12I6) 35 FORMAT(1H ,I3,3H999,I2,12I6) 50 FORMAT(I3,3H999,I2,12I6) 300 FORMAT(4I4) 400 FORMAT(2F7.3,F6.0,A3) 20 CONTINUE GO TO 1000 777 CONTINUE END SUBROUTINE NOMAN1(HR,IDAY,IYEAR,NCALC,DELT,ASTRON,TIDE) DIMENSION ASTRON(12, 250),TIDE(14, 250) REAL NOSTRA DATA R/57.2957795130823209/ DATA RC1,GM,GS/6.68449E-14,4.90287E18,1.32718E26/ DT= 42./86400./36525. C TIME FROM 1900 JAN 0.5 IN JULIAN CENTURIES IEXTRA = (IYEAR-1)/4 T=(365. * IYEAR + IEXTRA+ IDAY+ HR/24. -0.5)/36525-DELT/24./36525. C ....CONVERSION TO EPHEMERIS TIME BY ADDING 42 SECS......... T=T+DT W=(23.45229-0.01301*T)/R SINW=SIN(W) COSW=COS(W) E1=0.01675104-0.0000418*T C PRINT 21 C 21 FORMAT('1MOONS DECLIN SUNS DECLIN MOONS RT ASC SUNS RT ASC LUNAR C X PARALLAX SUNS DISTANCE AU'/) 9 DO 3 J=1,NCALC T=T+DELT/36525./24. T2=T*T T3=T2*T S=(270.43416 + 481267.88314*T-0.00113*T2)/R H=(279.69668+36000.76892*T+0.0003*T2) / R P=(334.32956+4069.03403*T-0.01032*T2 -0.00001*T3) / R PS=(281.22083+1.71918*T+0.00045*T2 )/R AN=(259.18328-1934.14201*T+0.00208*T2 )/R C ...... BL BLS BF BD ARE THE FUNDAMENTAL ARGUMENTS OF BROWNS THEORY BL= S-P BLS = H -PS BF=S-AN BD= S-H C........ LUNAR LAT LONG AND PARALLAX FROM BROWN. LATTER TWO FROM C..... IMPROVED LUNAR EPHEMERIS, LATITUDE FROM RAS PAPER OF 1908....... TLONGM=S+0.10976*SIN(BL)-0.02224*SIN(BL-2.*BD)+0.01149*SIN(2.*BD) 1+0.00373*SIN(2.*BL)-.00324*SIN(BLS) -.00200*SIN(2.*BF)-0.00103* 2SIN(2.*BL-2.*BD)-.00100*SIN(BL+BLS-2.*BD)+.00093*SIN(BL+2.*BD)- 3.00080*SIN(BLS-2.*BD)+.00072*SIN(BL-BLS)-.00061*SIN(BD)-.00053* 4SIN(BL+BLS) TLONGS=H+2.*E1*SIN(H-PS)+1.25*E1**2*SIN(2.*(H-PS)) TLATM =.08950*SIN(BF)+.00490*SIN(BL+BF)-.00485*SIN(BF-BL)-.00303 1 *SIN(BF-2.*BD) +.00097*SIN(2.*BD+BF-BL)-.00081*SIN(BL+BF-2.*BD) 2+.00057*SIN(BF+2.*BD) RDM=(3422.45+186.54*COS(BL)+34.31*COS(BL-2.*BD)+28.23*COS(2.*BD)+ 110.17*COS(2.*BL)+3.09*COS(BL+2.*BD)+1.92*COS(BLS-2.*BD)+1.44*COS( 2BL +BLS-2.*BD)+1.15*COS(BL-BLS)-0.98*COS(BD)-0.95*COS(BL+BLS)-0.71 3*COS(BL-2.*BF)+0.62*COS(3.*BL)+0.60*COS(BL-4.*BD))/1.31559E14 RDS=RC1*(1.+E1*COS(H-PS)+0.00028*COS(2.*(H-PS))) CONSTS=GS*(RDS**3) CONSTM=GM*(RDM**3) SINMLA =SIN(TLATM) COSMLA =COS(TLATM) SINMLN=SIN(TLONGM) COSMLN=COS(TLONGM) SINSLN=SIN(TLONGS) COSSLN=COS(TLONGS) C...CONVERT FROM CELESTIAL LAT AND LONG ACCORDING TO EXPLAN SUPPL OF C..... NA AND LE PAGE 26 COSPAS=SINSLN *SINW SINPAS=(1.-COSPAS**2)**0.5 ATS=SINSLN *COSW RAS= ATAN2(ATS,COSSLN) COSPAM=COSMLA*SINMLN*SINW+SINMLA*COSW SINPAM=(1.-COSPAM**2)**0.5 AT1=COSMLA*SINMLN*COSW-SINMLA*SINW AT2=COSMLA*COSMLNG RAM=ATAN2(AT1,AT2) RAGM=(15.*( HR+(J-1)*DELT-12.))/R+H TELS=RAS-RAGM TELM=RAM-RAGM SINTEL=SIN(TELS) COSTEL=COS(TELS) SINTEM=SIN(TELM) COSTEM=COS(TELM) S2TELS=2.*SINTEL*COSTEL C2TELS=COSTEL**2-SINTEL**2 S2TELM=2.*SINTEM*COSTEM C2TELM=COSTEM**2-SINTEM**2 C ...... THE CARDS FROM HERE TO THE NEXT COMMENT PROVIDE A PRINTOUT FOR C...... CHECKING THE ASTRONOMY ON EVERY 24 TH COMPUTATION. THEY MAY C...... BE OMITTED IF THIS CHECK IS NOT DESIRED........................ C I=(J-1)/24 C Q=(J-1)/24.-I C IF(Q .NE. 0.) GO TO 5 C PLXM=RDM*1.31559E14 C RVS=RC1/RDS C DECM=ASIN(COSPAM)*R $DECS=ASIN(COSPAS)*R C IDECM=DECM IDECS=DECS C FDECM=(DECM-IDECM)*60. FDECS=(DECS-IDECS)*60. C FDECM=ABS(FDECM) FDECS=ABS(FDECS) C DRAM=RAM*R/15. DRAS=RAS*R/15. IRAM=DRAM IRAS=DRAS FRAM=(DRAM-IRAM)*60. FRAS=(DRAS-IRAS)*60. FRAM=ABS(FRAM) FRAS=ABS(FRAS) C PRINT 11,IDECM,FDECM,IDECS,FDECS,IRAM,FRAM,IRAS,FRAS,PLXM,RVS C 11 FORMAT(1H ,4(I3,1X,F6.2,3X),F15.3,F15.7) C 5 CONTINUE C.... END OF OPTIONAL ASTRONOMICAL PRINTOUT ASTRON(1,J)=0.25*CONSTS*(3.*COSPAS**2-1.)+0.25*CONSTM*(3.*COSPAM** X2-1.) CASA=3.*CONSTS*SINPAS*COSPAS NOSTRA=3.*CONSTM*SINPAM*COSPAM ASTRON(2,J)=CASA*COSTEL+NOSTRA*COSTEM ASTRON(3,J)=CASA*SINTEL+NOSTRA*SINTEM CASA=0.75*CONSTS*SINPAS**2 NOSTRA=0.75*CONSTM*SINPAM**2 ASTRON(4,J) =CASA*C2TELS + NOSTRA*C2TELM ASTRON(5,J) =CASA*S2TELS + NOSTRA*S2TELM CONSTM= CONSTM*RDM ASTRON(6,J) = 0.25*CONSTM*(5.*COSPAM**3-3.*COSPAM) NOSTRA=0.375*SINPAM*(5.*COSPAM**2 -1.)*CONSTM ASTRON(7,J)=NOSTRA*COSTEM ASTRON(8,J)=NOSTRA*SINTEM NOSTRA=3.75*CONSTM*SINPAM**2*COSPAM ASTRON(9,J)=NOSTRA*C2TELM ASTRON(10,J)=NOSTRA*S2TELM NOSTRA=0.625*(SINPAM**3)*CONSTM ASTRON(11,J)=NOSTRA*(4.*COSTEM**3-3.*COSTEM) ASTRON(12,J)=NOSTRA*(3.*SINTEM-4.*SINTEM**3) 3 CONTINUE RETURN END SUBROUTINE NOMAN2(SLAT,SLONG,SH,KIND,ALPHA,NCALC,ASTRON,TIDE) DIMENSION ASTRON(12,250),TIDE(14,250) DIMENSION GEOG(12) DATA R/57.2957795130823209/ SLATR=SLAT/R DEL=.00337*SIN(2.*SLATR) SLATR=SLATR-DEL CSPA=SIN(SLATR) SNPA=COS(SLATR) SNLNG=SIN(SLONG/R) CSLNG=COS(SLONG/R) CSALF=COS(ALPHA/R) SNALF=SIN(ALPHA/R) C2LNG=CSLNG**2-SNLNG**2 S2LNG=2.*SNLNG*CSLNG CPA2=CSPA**2 SPA2=SNPA**2 SNGSPA=SNPA*CSPA A1=CSALF**2 A2=SNALF**2 A3=-CSALF*SNALF C3LNG=4.* CSLNG**3-3.*CSLNG S3LNG=3.*SNLNG-4.*SNLNG**3 RSTA=6.378160E8*(1.-.003353*CSPA**2) + 100.*SH GO TO(1,2,3,4,5,6,7,5,7),KIND 1 GEOG(1) = 3. * CPA2-1. GEOG(2) = SNCSPA * CSLNG GEOG(3)= SNCSPA * SNLNG GEOG(4)= SPA2 * C2LNG GEOG(5)= SPA2 * S2LNG GEOG(6)= 5.*CSPA**3-3.*CSPA GEOG(7)= SNPA*(5.*CPA2 - 1.)*CSLNG GEOG(8)= SNPA*(5.*CPA2 - 1.)*SNLNG GEOG(9)= SPA2 * CSPA*C2LNG GEOG(10)=SPA2 * CSPA*S2LNG GEOG(11)=SNPA**3*C3LNG GEOG(12)=SNPA**3*S3LNG A=-2.*RSTA*10**6 B=-3.*RSTA**2*10**6 GO TO 10 2 GEOG(1)= 6.* SNCSPA *CSALF GEOG(2)=-(CPA2 - SPA2) * CSLNG*CSALF-CSPA*SNLNG*SNALF GEOG(3)=-(CPA2 - SPA2) * SNLNG*CSALF+CSPA*CSLNG*SNALF GEOG(4)=-2.*SNCSPA * C2LNG*CSALF-2.*SNPA*S2LNG*SNALF GEOG(5)=-2.*SNCSPA * S2LNG*CSALF+2.*SNPA*C2LNG*SNALF GEOG(6)=-3.*SNPA*(1.- 5.*CPA2) * CSALF GEOG(7)=-CSPA*(5.*(CPA2 - 2.*SPA2) -1.) * CSLNG*CSALF-(5.*CPA2-1. X) * SNLNG*SNALF GEOG(8)=-CSPA*(5.*(CPA2 - 2.*SPA2) -1.) * SNLNG*CSALF+(5.*CPA2-1. X) * CSLNG*SNALF GEOG(9)=-SNPA*(2.*CPA2-SPA2)*C2LNG*CSALF -2.*SNCSPA*S2LNG*SNALF GEOG(10)=-SNPA*(2.*CPA2-SPA2)*S2LNG*CSALF+2.*SNCSPA*C2LNG*SNALF GEOG(11)=-3.*SPA2 * CSPA*C3LNG*CSALF-3.* SPA2 * S3LNG*SNALF GEOG(12)=-3.*SPA2 * CSPA*S3LNG*CSALF+3.* SPA2 * C3LNG*SNALF A=RSTA*10**9/979.8 B=RSTA*A GO TO 10 3 GEOG(1)= -6.*(CPA2 - SPA2)*A1 - 6.*CPA2*A2 GEOG(2)= -4.*SNCSPA*CSLNG*A1-2.*SNCSPA*CSLNG*A2 + 2.*SNPA*SNLNG*A3 GEOG(3)= -4.*SNCSPA*SNLNG*A1 - 2.*SNCSPA*SNLNG*A2-2.*SNPA*CSLNG*A3 GEOG(4)=2.*(CPA2-SPA2)*C2LNG*A1+2.*C2LNG*(CPA2-2.)*A2-4.*CSPA* 1S2LNG*A3 GEOG(5)=2.*(CPA2-SPA2)*S2LNG*A1+2.*S2LNG*(CPA2-2.)*A2+4.*CSPA* 1C2LNG*A3 GEOG(6)=(30.*CSPA*SPA2-15.*CSPA*CPA2+3.*CSPA)*A1 + 3.*CSPA*(1.- 15.*CPA2)*A2 GEOG(7)=SNPA*(15.*SPA2-14.)*CSLNG*A2+SNPA*(45.*SPA2-34.)*CSLNG*A1 1+20.*SNCSPA*SNLNG*A3 GEOG(8)= SNPA*(15.*SPA2-14.)*SNLNG*A2 + SNPA*(45.*SPA2-34.)*SNLNG* 1A1 - 20.*SNCSPA*CSLNG*A3 GEOG(9)= CSPA*C2LNG*(2.*CPA2-7.*SPA2)*A1 +CSPA*C2LNG*(2.*CPA2- 1SPA2-4.)*A2 + 4.*S2LNG*(SPA2-CPA2)*A3 GEOG(10)= CSPA*S2LNG*(2.*CPA2-7.*SPA2)*A1 +CSPA*S2LNG*(2.*CPA2- 1SPA2-4.)*A2 + 4.*C2LNG*(CPA2-SPA2)*A3 GEOG(11)= SNPA*C3LNG*(6.*CPA2-3.*SPA2)*A1 +3.*SNPA*C3LNG*(CPA2- 13.)*A2-12.*SNCSPA*S3LNG*A3 GEOG(12)= SNPA*S3LNG*(6.*CPA2-3.*SNPA)*A1 +3.*SNPA*S3LNG*(CPA2- 3 3.)*A2+12.*SNCSPA*C3LNG*A3 A=RSTA*10**9/979.8 B=RSTA*A GO TO 10 4 GEOG(1)= 3.*CPA2-1. GEOG(2)= SNCSPA * CSLNG GEOG(3)= SNCSPA * SNLNG GEOG(4)= SPA2 * C2LNG GEOG(5)= SPA2 * S2LNG GEOG(6)= 5.*CSPA**3-3.*CSPA GEOG(7)= SNPA*(5.*CPA2 - 1.)*CSLNG GEOG(8)= SNPA*(5.*CPA2 - 1.)*SNLNG GEOG(9)= SPA2 * CSPA*C2LNG GEOG(10)=SPA2 * CSPA*S2LNG GEOG(11)= SNPA**3*C3LNG GEOG(12)= SNPA**3*S3LNG A=RSTA*10**9/979.8 B=RSTA*A GO TO 10 5 GEOG(1)= 3.*CPA2-1. GEOG(2)= SNCSPA * CSLNG GEOG(3)= SNCSPA * SNLNG GEOG(4)= SPA2 * C2LNG GEOG(5)= SPA2 * S2LNG GEOG(6)= 5.*CSPA**3-3.*CSPA GEOG(7)= SNPA*(5.*CPA2 - 1.)*CSLNG GEOG(8)= SNPA*(5.*CPA2 - 1.)*SNLNG GEOG(9)= SPA2 * CSPA*C2LNG GEOG(10)=SPA2 * CSPA*S2LNG GEOG(11)=SNPA**3*C3LNG GEOG(12)=SNPA**3*S3LNG A=RSTA**2 B=A*RSTA GO TO 11 6 GEOG(1)=-2.*(3.*CPA2-1.)-DEL*6.*SNCSPA GEOG(2)=(-2.*SNCSPA+DEL*(CPA2-SPA2))*CSLNG GEOG(3)=(-2.*SNCSPA+DEL*(CPA2-SPA2))*SNLNG GEOG(4)=(-2.*SPA2+DEL*(2.*SNCSPA))*C2LNG GEOG(5)=(-2.*SPA2+DEL*(2.*SNCSPA))*S2LNG GEOG(6)= 5.*CSPA**3-3.*CSPA GEOG(7)= SNPA*(5.*CPA2 - 1.)*CSLNG GEOG(8)= SNPA*(5.*CPA2 - 1.)*SNLNG GEOG(9)= SPA2 * CSPA*C2LNG GEOG(10)=SPA2 * CSPA*S2LNG GEOG(11)=SNPA**3*C3LNG GEOG(12)=SNPA**3*S3LNG A=RSTA*10**6 B=-3.*RSTA**2*10**6 GO TO 10 7 GEOG(1)=(6.*SNCSPA-DEL*2.*(3.*CPA2-1.))*CSALF GEOG(2)=(-(CPA2-SPA2)-DEL*2.*SNCSPA)*CSLNG*CSALF-CSPA*SNLNG*SNALF GEOG(3)=(-(CPA2-SPA2)-DEL*2.*SNCSPA)*SNLNG*CSALF+CSPA*CSLNG*SNALF GEOG(4)=(-2.*SNCSPA-DEL*2.*SPA2)*C2LNG*CSALF-2.*SNPA*S2LNG*SNALF GEOG(5)=(-2.*SNCSPA-DEL*2.*SPA2)*S2LNG*CSALF+2.*SNPA*C2LNG*SNALF GEOG(6)=-3.*SNPA*(1.- 5.*CPA2) * CSALF GEOG(7)=-CSPA*(5.*(CPA2 - 2.*SPA2) -1.) * CSLNG*CSALF-(5.*CPA2-1. X) * SNLNG*SNALF GEOG(8)=-CSPA*(5.*(CPA2 - 2.*SPA2) -1.) * SNLNG*CSALF+(5.*CPA2-1. X) * CSLNG*SNALF GEOG(9)=-SNPA*(2.*CPA2-SPA2)*C2LNG*CSALF -2.*SNCSPA*S2LNG*SNALF GEOG(10)=-SNPA*(2.*CPA2-SPA2)*S2LNG*CSALF+2.*SNCSPA*C2LNG*SNALF GEOG(11)=-3.*SPA2 * CSPA*C3LNG*CSALF-3.* SPA2 * S3LNG*SNALF GEOG(12)=-3.*SPA2 * CSPA*S3LNG*CSALF+3.* SPA2 * C3LNG*SNALF A=RSTA*10**9/979.8 B=RSTA*A 11 IF(KIND.NE.8) GO TO 12 A=A/979.8 B=B/979.8 12 IF(KIND.NE.9) GO TO 10 A=A*RSTA/1E9 B=B*RSTA/1E9 10 CONTINUE DO 211 I=1,NCALC TIDE(1,I)=A*GEOG(1)*ASTRON(1,I) TIDE(2,I)=A*GEOG(2)*ASTRON(2,I) TIDE(3,I)=A*GEOG(3)*ASTRON(3,I) TIDE(4,I)=A*GEOG(4)*ASTRON(4,I) TIDE(5,I)=A*GEOG(5)*ASTRON(5,I) DO 212 J=6,12 TIDE(J,I)=B*GEOG(J)*ASTRON(J,I) 212 CONTINUE SUM=0. DO 213 J=1,5 SUM=SUM+TIDE(J,I) TIDE(13,I)=SUM 213 CONTINUE DO 214 J=6,12 SUM=SUM+TIDE(J,I) 214 CONTINUE TIDE(14,I) = SUM 211 CONTINUE RETURN