astro.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\astro.f
00002 !
00130                      SUBROUTINE ASTRO
00131 !                    ****************
00132 !
00133      &(YEAR,MONTH,DAY,HOUR,MINU,SEC,AT,ARL,ARS,DL,DS,AL,AS)
00134 !
00135 !***********************************************************************
00136 ! TELEMAC2D   V7P0
00137 !***********************************************************************
00138 !
00139 !
00140 !
00141 !
00142 !!
00143 !
00144 !
00145 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00146 !| AL             |<--| MOON RIGHT ASCENSION
00147 !| ARL            |<--| RATIO RT/TL
00148 !| ARS            |<--| RATIO RT/TS
00149 !| AS             |<--| SUN RIGHT ASCENSION
00150 !| AT             |-->| TIME IN SECONDS
00151 !| DAY            |-->| DAY
00152 !| DL             |<--| MOON DECLINATION
00153 !| DS             |<--| SUN DECLINATION
00154 !| HOUR           |-->| HOUR
00155 !| MINU           |-->| MINUTE
00156 !| MONTH          |-->| DATE DU CALCUL DES TERMES ASTROS
00157 !| SEC            |-->| SECOND
00158 !| YEAR           |-->| DATE DU CALCUL DES TERMES ASTROS
00159 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00160 !
00161       IMPLICIT NONE
00162       INTEGER LNG,LU
00163       COMMON/INFO/LNG,LU
00164 !
00165 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00166 !
00167       INTEGER, INTENT(IN)             :: YEAR,MONTH,DAY,HOUR,MINU,SEC
00168       DOUBLE PRECISION, INTENT(IN)    :: AT
00169       DOUBLE PRECISION, INTENT(INOUT) :: ARL,ARS,DL,DS,AL,AS
00170 !
00171 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00172 !
00173       DOUBLE PRECISION T,H,S,P,O,OM,L,CR,ET,MA,EA,TS,VS,LS
00174       DOUBLE PRECISION I0,E,M,UA,RT,C,AC,PI,API,EA1,KSI,I,X,NU
00175 !
00176       INTRINSIC ACOS,ASIN,ATAN,COS,SIN,SQRT,TAN,ABS,MOD,ATAN2
00177 !
00178       DOUBLE PRECISION DMO,JULTIM
00179       EXTERNAL         DMO,JULTIM
00180 !
00181 !-----------------------------------------------------------------------
00182 !
00183       PI  = ACOS (-1.D0)
00184       API = PI / 180.D0
00185       I0  = 5.145576994D0 * API
00186       E   = 0.05490D0
00187       M   = 0.074804D0
00188       UA  = 149503899.D0
00189       RT  = 6378.D0
00190       C   = 384403.D0
00191       AC  = RT / C
00192 !
00193       T   = JULTIM(YEAR,MONTH,DAY,HOUR,MINU,SEC,AT)
00194 !
00195       H   = DMO ( 279.69668D0 + 36000.76892D0       * T
00196      &                        + 0.0003025D0         * T**2 )
00197       S   = DMO ( 270.434164D0 + 481267.8831D0      * T
00198      &                         - 0.001133D0         * T**2
00199      &                         + 0.0000019D0        * T**3 )
00200       P   = DMO ( 334.328019444D0 + 4069.03220556D0 * T
00201      &                            - 0.01034D0       * T**2
00202      &                            + 0.0000125D0     * T**3 )
00203       O   = DMO ( 259.183275D0 - 1934.1420D0        * T
00204      &                         + 0.002078D0         * T**2
00205      &                         + 0.0000022D0        * T**3 )
00206       OM  = DMO ( 23.452294D0 - 0.0130125D0         * T
00207      &                        - 0.00000164D0        * T**2
00208      &                        + 0.000000503D0       * T**3 )
00209       L   = S + 2*E*SIN(S-P) +  5.D0/4.D0 *E*E*SIN(2*(S-P)) +
00210      &                         15.D0/4.D0 *M*E*SIN(S-2*H+P) +
00211      &                         11.D0/8.D0 *M*M*SIN(2*(S-H))
00212       CR  = 1.D0 + E*COS(S-P) +            E*E*COS(2*(S-P)) +
00213      &                         15.D0/8.D0 *M*E*COS(S-2*H+P) +
00214      &                                     M*M*COS(2*(S-H))
00215       KSI=MOD(O-ATAN(SIN(O)/(SIN(I0)/TAN(OM)+COS(I0)*COS(O))),PI)
00216 !
00217 ! KSI VARIES FROM -12 TO +12 DEGREES IN 18.7 YEARS
00218 !
00219       IF (KSI.GT.+API*13.D0) KSI=KSI-PI
00220       IF (KSI.LT.-API*13.D0) KSI=KSI+PI
00221 !
00222 ! CALCULATES I
00223 !
00224       I   = ACOS( COS(OM)*COS(I0) - SIN(OM)*SIN(I0)*COS(O) )
00225 !
00226       ET  = 0.01675104D0 - 0.0000418D0 * T - 0.000000126D0 * T**2
00227       MA  = DMO ( 358.47583D0 + 35999.04975D0 * T
00228      &                        - 0.00015D0     * T**2
00229      &                        + 0.0000033D0   * T**3 )
00230       EA1 = MA
00231 10    CONTINUE
00232       EA  = MA + ET * SIN (EA1)
00233       IF(ABS(EA-EA1).GT.1.D-12) THEN
00234         EA1=EA
00235         GOTO 10
00236       ENDIF
00237       TS  = 1.0000002D0 * ( 1.D0-ET*COS(EA) ) * UA
00238       VS  = 2.D0 * ATAN( SQRT((1.D0+ET)/(1.D0-ET)) * TAN(EA/2.D0) )
00239       LS  = H + VS - MA
00240 !
00241 ! OUTPUT PARAMETERS
00242 !
00243       ARL = AC*CR
00244       ARS = RT/TS
00245       DL  = ASIN(SIN(L-KSI)*SIN(I))
00246       DS  = ASIN(SIN(OM)*SIN(LS))
00247 !     CALCULATES X SO THAT TAN(X) = TAN(L-KSI) * COS(I)
00248 !     WITH X BETWEEN 0 AND 2 PI
00249       X  = ATAN2(SIN(L-KSI)*COS(I),COS(L-KSI))+PI
00250       NU = ATAN2(SIN(O),SIN(OM)/TAN(I0)+COS(OM)*COS(O))+PI
00251       AL = MOD(X+NU,2.D0*PI)
00252       AS = ATAN2(COS(OM)*SIN(LS),COS(LS))
00253 !
00254 !-----------------------------------------------------------------------
00255 !
00256       RETURN
00257       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0