البرنامج رقم 18... برنامج العبور الكامل

البرنامج رقم 18... برنامج العبور الكامل

هذا هو البرنامج الكامل لعبور الشمس المستخدم في التحاويل هدية لاخوي العزيزين غسان ومناضل وهو عربون صداقة ومحبة برغم كل من يحاول شق صف العباقرة الشامليين...

البرنامج الرئيسي...

CLS

REM Calculate Date of Cross

INPUT "Year:"; Y

INPUT "Month:"; M

INPUT "Day:"; D

INPUT "Hour:"; H

INPUT "Minute"; N

INPUT "Zone:"; Z

INPUT "Age"; YY

B = 0

IF 10000 * Y + 100 * M + D > 15821015 THEN B = 2 - INT(Y / 100) + INT(Y / 400)

M = M + 1

IF M < 4 THEN M = M + 12: Y = Y - 1

DD = INT(365.25 * Y) + INT(30.6 * M) + D + B + (H - Z + N / 60) / 24 - 730916

GOSUB 10

PRINT "Natal Longitude of Sun:"; L

L1 = L

DD = DD + YY * 365.2422

2 GOSUB 10

L2 = L

LL = L2 - L1

IF ABS(LL) > .0001 THEN DD = DD - LL: GOTO 2

DD = DD + 730487 + Z / 24

H1 = INT((DD - INT(DD)) * 24)

M1 = INT(((DD - INT(DD)) * 24 - H1) * 60)

I = INT(DD)

IF I > 577736 THEN A = INT((I + 306) / 36524.25): I = I + A - INT(A / 4) - 2

Y = INT((I + 306) / 365.25)

C = I - INT(Y * 365.25) + 429

G = INT(C / 30.6001)

M = G - 1: IF G > 13 THEN M = M - 12

IF M < 3 THEN Y = Y + 1

D = C - INT(G * 30.6001)

PRINT "Date of Cross:(Year Month Day Hour Minute)"; Y; M; D; H1; M1

END

-----------------------------------

وهذا البرنامج الفرعي الذي يحسب موقع الشمس على مدار البروج بدقة متناهية...

10 REM Calulating Sun Position...

PI = 57.29577951#

DEF FNANG (A, B, C, D, PI) = (A + 360 * B * D + C * D * D - INT((A + 360 * B * D + C * D * D) / 360) * 360) / PI

D = (DD + 36890.5) / 365.25

LS = FNANG(279.69668#, 1.000021359#, 3.025E-08, D, PI)

MS = FNANG(358.47583#, .9999736042#, 1.5E-08, D, PI)

E = .01675104# - 4.18E-07 * D

A1 = FNANG(153.23, .6255209472#, 0, D, PI)

A2 = FNANG(216.57, 1.251041894#, 0, D, PI)

A3 = FNANG(312.69, .9156766028#, 0, D, PI)

A4 = FNANG(350.74, 12.36853095#, 1.44E-07, D, PI)

A5 = FNANG(231.19, .0561111111#, 0, D, PI)

T = MS

1 D = (T - E * SIN(T) - MS) / (1 - E * COS(T))

IF ABS(D) > .000001 THEN T = T - D: GOTO 1

NU = 2 * ATN(SQR((1 + E) / (1 - E)) * TAN(T / 2))

L = (NU + LS - MS) * PI + .00134 * COS(A1) + .00154 * COS(A2) + .002 * COS(A3) + .00179 * SIN(A4) + .00178 * SIN(A5)

L = INT((L-INT(L/360)*360) * 1000) / 1000

RETURN

لا اعلم ماذا اسمي هذا ابداع ام اخلاص ام ثقافه ام تحدي
اذهلتني ابدعاتك المتناثره في ارجاء المنتدى
كل التقدير والاحترام

احسنت الاختيار موضوع مميز

ننتظر المزيد من التالق ( امتنانى )

احسنت الاختيار موضوعك قيم
بالتوفيق دائما بكل اختياراتك

أبداع بكل معنى الكلمة
احترامي وورودى

لكم منى كل التقدير على جمال الطرح
خالص احترامى ومودتتى

موضوع جميل جداً استمتعت به
ننتظر منكم المزيد من الابداع
اتمنى لكم السعاده والتوفيق..

احسنت الاختيار تـسلم عالطرح الرائع
يدوم عطائك المميز . تحياتى لشخصك

شكرا على الطرح الطيب والموضوع المميز

يسلموا لروعة الطرح المميز والانتقاء الجيد
يعطيك العافيه ,,,,, خالص احترامي

» البرنامج 19... برنامج تقسيم البيوت بطريقة القابسي...
» يخت المحروسة يسجل العبور الثاني لقناة السويس
» التاريخ الكامل لمنظمة WWE :
» النص الكامل لكلمه الرئيس السيسي اليوم
» الجدول الكامل لكأس العالم البرازيل 2014