DF'SIOS BOY'
ED'SIOS BOY'
IN0
PAGE
IDP "SIOS BOY"
<
<
< M I S E S U R U N E S U R F A C E D E B O Y :
<
<
< EQUATION :
< A(MU)=A0+A1*SIN(6*MU-PI/3)+A2*SIN(3*MU-PI/6),
< B(MU)=A0+A1*SIN(6*MU-PI/3)-A2*SIN(3*MU-PI/6),
< ALPHA=(PI/8)*SIN(3*MU),
< X1=(A*A-B*B)/RAC(A*A+B*B)+A*COS(TETA)-B*SIN(TETA),
< Z1=RAC(A*A+B*B)+A*COS(TETA)+B*SIN(TETA),
< X=X1*COS(MU)-Z1*SIN(ALPHA)*SIN(MU),
< Y=X1*SIN(MU)+Z1*SIN(ALPHA)*COS(MU),
< Z=Z1*COS(ALPHA).
< OU :
< TETA=U, ET VARIE SUR (0,2*PI),
< MU=V, ET VARIE SUR (0,PI),
< A0 EST LA CONSTANTE PROGRAMMABLE 'A 0000',
< A1 EST 'A 0001', ET
< A2 EST 'A 0002',
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
<
<
< A T T E N T I O N :
< CETTE VERSION 'BOY' NE CONVIENT
< PAS SI L'ON DESIRE UTILISER L'OP-
< TION ECLAIRAGE 'LITE' DE T4/T6 ; IL
< FAUT ALORS UTILISER 'BOY LITE' !!!
<
<
LOCAL
FLOC: EQU $
<
< VARIABLES DE MANOEUVRE :
<
WXF1: FLOAT 0 < A2*SIN(3*MU-PI/6), RAC(A*A+B*B), SIN(MU).
WXF2: FLOAT 0 < A*COS(TETA), COS(MU).
WXF3: FLOAT 0 < B*SIN(TETA), Z1*SIN(ALPHA).
WXF4: FLOAT 0 < A*A, Z1*SIN(ALPHA)*SIN(MU),
< Z1*SIN(ALPHA)*COS(MU).
WXF5: FLOAT 0 < B*B.
XFA: FLOAT 0 < A.
XFB: FLOAT 0 < B.
XALPHA: FLOAT 0 < ALPHA.
XX1: FLOAT 0 < X1.
XZ1: FLOAT 0 < Z1.
<
< PARAMETRES :
<
XF10: FLOAT 10 < A0.
XF141: FLOAT 1.41 < A1.
XF198: FLOAT 1.98 < A2.
XF3: EQU F3
PI: EQU PI3141
XF8: FLOAT 8
XFPI6: FLOAT 0.5235987 < PI/6.
<
< PARAMETRES :
<
TETA: EQU VARU
MU: EQU VARV
PROG
<
<
< C O M P O S A N T E ' U ' :
<
<
SPU: EQU $
<
< ENTREE DES PARAMETRES :
<
LXI A0
BSR ASPCT
FST XF10
LXI A1
BSR ASPCT
FST XF141
LXI A2
BSR ASPCT
FST XF198
<
< CALCUL DES VALEURS UTILISEES POUR
< LES 3 COMPOSANTES :
<
FLD MU
FMP XF3
FSB XFPI6
PSR A,B < 3*MU-PI/6,
BSR ASIN < SIN(3*MU-PI/6),
FMP XF198
FST WXF1 < A2*SIN(3*MU-PI/6).
PLR A,B < 3*MU-PI/6),
FDV F05 < 6*MU-PI/3,
BSR ASIN < SIN(6*MU-PI/3),
FMP XF141 < A1*SIN(6*MU-PI/3),
FAD XF10 < A0+A1*SIN(6*MU-PI/3),
PSR A,B
FAD WXF1
FST XFA < A=A0+A1*SIN(6*MU-PI/3)+A2*SIN(3*MU-PI/6).
PLR A,B < A0+A1*SIN(6*MU-PI/3),
FSB WXF1
FST XFB < B=A0+A1*SIN(6*MU-PI/3)-A2*SIN(3*MU-PI/6).
FLD MU
FMP XF3
BSR ASIN
FMP PI
FDV XF8
FST XALPHA < ALPHA=(PI/8)*SIN(3*MU).
FLD TETA
BSR ACOS
FMP XFA
FST WXF2 < A*COS(TETA).
FLD TETA
BSR ASIN
FMP XFB
FST WXF3 < B*SIN(TETA).
FLD XFA
FMP XFA
FST WXF4 < A*A.
FLD XFB
FMP XFB
FST WXF5 < B*B.
FAD WXF4 < A*A+B*B,
BSR ARAC
FST WXF1 < RAC(A*A+B*B).
FLD WXF4
FSB WXF5 < A*A-B*B,
FDV WXF1 < (A*A-B*B)/RAC(A*A+B*B),
FAD WXF2
FSB WXF3
FST XX1 < X1=(A*A-B*B)/RAC(A*A+B*B)+
< A*COS(TETA)-B*SIN(TETA).
FLD WXF1 < RAC(A*A+B*B),
FAD WXF2
FAD WXF3
FST XZ1 < Z1=RAC(A*A+B*B)+A*COS(TETA)+B*SIN(TETA).
FLD MU
BSR ASIN
FST WXF1 < SIN(MU).
FLD MU
BSR ACOS
FST WXF2 < COS(MU).
FLD XALPHA
BSR ASIN
FMP XZ1
FST WXF3 < Z1*SIN(ALPHA).
<
< COORDONNEE EN 'U' :
<
FMP WXF1 < Z1*SIN(ALPHA)*SIN(MU),
FST WXF4
FLD WXF2 < COS(MU),
FMP XX1 < X1*COS(MU),
FSB WXF4 < X=X1*COS(MU)-Z1*SIN(ALPHA)*SIN(MU).
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
FLD WXF3 < Z1*SIN(ALPHA),
FMP WXF2 < Z1*SIN(ALPHA)*COS(MU),
FST WXF4
FLD WXF1 < SIN(MU),
FMP XX1 < X1*SIN(MU),
FAD WXF4 < Y=X1*SIN(MU)+Z1*SIN(ALPHA)*COS(MU).
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
FLD XALPHA
BSR ACOS
FMP XZ1 < Z=Z1*COS(ALPHA).
RSR
:F
:F
< <<'SIOS BOY'
DF'SIOS BOY LITE'
ED'SIOS BOY LITE'
IN0
PAGE
IDP "SIOS BOY LITE"
<
<
< M I S E S U R U N E S U R F A C E D E B O Y :
< ( A V E C P O S S I B I L I T E D E ' L I T E ' )
<
<
< EQUATION :
< A(MU)=A0+A1*SIN(6*MU-PI/3)+A2*SIN(3*MU-PI/6),
< B(MU)=A0+A1*SIN(6*MU-PI/3)-A2*SIN(3*MU-PI/6),
< ALPHA=(PI/8)*SIN(3*MU),
< X1=(A*A-B*B)/RAC(A*A+B*B)+A*COS(TETA)-B*SIN(TETA),
< Z1=RAC(A*A+B*B)+A*COS(TETA)+B*SIN(TETA),
< X=X1*COS(MU)-Z1*SIN(ALPHA)*SIN(MU),
< Y=X1*SIN(MU)+Z1*SIN(ALPHA)*COS(MU),
< Z=Z1*COS(ALPHA).
< OU :
< TETA=U, ET VARIE SUR (0,2*PI),
< MU=V, ET VARIE SUR (0,PI),
< A0 EST LA CONSTANTE PROGRAMMABLE 'A 0000',
< A1 EST 'A 0001', ET
< A2 EST 'A 0002',
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
<
<
< NOTA :
< 'BOY LITE' CONVIENT QU'IL Y AIT
< ECLAIRAGE OU PAS, MAIS EST DONC
< PLUS LENT QUE 'BOY'...
<
<
LOCAL
FLOC: EQU $
<
< VARIABLES DE MANOEUVRE :
<
WXF1: FLOAT 0 < A2*SIN(3*MU-PI/6), RAC(A*A+B*B), SIN(MU).
WXF2: FLOAT 0 < A*COS(TETA), COS(MU).
WXF3: FLOAT 0 < B*SIN(TETA), Z1*SIN(ALPHA).
WXF4: FLOAT 0 < A*A, Z1*SIN(ALPHA)*SIN(MU),
< Z1*SIN(ALPHA)*COS(MU).
WXF5: FLOAT 0 < B*B.
XFA: FLOAT 0 < A.
XFB: FLOAT 0 < B.
XALPHA: FLOAT 0 < ALPHA.
XX1: FLOAT 0 < X1.
XZ1: FLOAT 0 < Z1.
<
< PARAMETRES :
<
XF10: FLOAT 10 < A0.
XF141: FLOAT 1.41 < A1.
XF198: FLOAT 1.98 < A2.
XF3: EQU F3
PI: EQU PI3141
XF8: FLOAT 8
XFPI6: FLOAT 0.5235987 < PI/6.
<
< PARAMETRES :
<
TETA: EQU VARU
MU: EQU VARV
<
< SOUS-PROGRAMMES :
<
ASP1: WORD SP1 < CALCUL DES VALEURS UTILES...
PROG
<
<
< C A L C U L D E S P A R A M E T R E S :
<
<
SP1: EQU $
<
< ENTREE DES PARAMETRES :
<
LXI A0
BSR ASPCT
FST XF10
LXI A1
BSR ASPCT
FST XF141
LXI A2
BSR ASPCT
FST XF198
<
< CALCUL DES VALEURS UTILISEES POUR
< LES 3 COMPOSANTES :
<
FLD MU
FMP XF3
FSB XFPI6
PSR A,B < 3*MU-PI/6,
BSR ASIN < SIN(3*MU-PI/6),
FMP XF198
FST WXF1 < A2*SIN(3*MU-PI/6).
PLR A,B < 3*MU-PI/6),
FDV F05 < 6*MU-PI/3,
BSR ASIN < SIN(6*MU-PI/3),
FMP XF141 < A1*SIN(6*MU-PI/3),
FAD XF10 < A0+A1*SIN(6*MU-PI/3),
PSR A,B
FAD WXF1
FST XFA < A=A0+A1*SIN(6*MU-PI/3)+A2*SIN(3*MU-PI/6).
PLR A,B < A0+A1*SIN(6*MU-PI/3),
FSB WXF1
FST XFB < B=A0+A1*SIN(6*MU-PI/3)-A2*SIN(3*MU-PI/6).
FLD MU
FMP XF3
BSR ASIN
FMP PI
FDV XF8
FST XALPHA < ALPHA=(PI/8)*SIN(3*MU).
FLD TETA
BSR ACOS
FMP XFA
FST WXF2 < A*COS(TETA).
FLD TETA
BSR ASIN
FMP XFB
FST WXF3 < B*SIN(TETA).
FLD XFA
FMP XFA
FST WXF4 < A*A.
FLD XFB
FMP XFB
FST WXF5 < B*B.
FAD WXF4 < A*A+B*B,
BSR ARAC
FST WXF1 < RAC(A*A+B*B).
FLD WXF4
FSB WXF5 < A*A-B*B,
FDV WXF1 < (A*A-B*B)/RAC(A*A+B*B),
FAD WXF2
FSB WXF3
FST XX1 < X1=(A*A-B*B)/RAC(A*A+B*B)+
< A*COS(TETA)-B*SIN(TETA).
FLD WXF1 < RAC(A*A+B*B),
FAD WXF2
FAD WXF3
FST XZ1 < Z1=RAC(A*A+B*B)+A*COS(TETA)+B*SIN(TETA).
FLD MU
BSR ASIN
FST WXF1 < SIN(MU).
FLD MU
BSR ACOS
FST WXF2 < COS(MU).
FLD XALPHA
BSR ASIN
FMP XZ1
FST WXF3 < Z1*SIN(ALPHA).
RSR
<
<
< C O O R D O N N E E E N ' U ' :
<
<
SPU: EQU $
BSR ASP1 < CALCUL DES PARAMETRES ; RENVOIE :
< Z1*SIN(ALPHA).
<
< COORDONNEE EN 'U' :
<
FMP WXF1 < Z1*SIN(ALPHA)*SIN(MU),
FST WXF4
FLD WXF2 < COS(MU),
FMP XX1 < X1*COS(MU),
FSB WXF4 < X=X1*COS(MU)-Z1*SIN(ALPHA)*SIN(MU).
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
BSR ASP1 < CALCUL DES PARAMETRES ; RENVOIE :
< Z1*SIN(ALPHA),
FMP WXF2 < Z1*SIN(ALPHA)*COS(MU),
FST WXF4
FLD WXF1 < SIN(MU),
FMP XX1 < X1*SIN(MU),
FAD WXF4 < Y=X1*SIN(MU)+Z1*SIN(ALPHA)*COS(MU).
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
BSR ASP1 < CALCUL DES PARAMETRES...
FLD XALPHA
BSR ACOS
FMP XZ1 < Z=Z1*COS(ALPHA).
RSR
:F
:F
< <<'SIOS BOY LITE'
DF'SIOS COQUILLAGE 1'
ED'SIOS COQUILLAGE 1'
IN0
PAGE
IDP "SIOS COQUILLAGE 1"
<
<
< C O Q U I L L A G E 1 :
<
<
< FONCTION :
< CE MODULE REFERENCABLE PAR
< 'SI T6' VIA 'SI FONCTION' PERMET
< LA CONSTRUCTION DE LA SURFACE
< D'EQUATION :
<
< X=A0*U+A1*COS(U)*COS(V),
< Y=A2*V+A3*SIN(U)*COS(V),
< Z=A4*V+A5*SIN(V).
<
<
< PARAMETRES :
A0:: VAL 0 < 'CX10' DE 'TZ',
A1:: VAL A0+1 < 'CXBC' DE 'TZ',
A2:: VAL A1+1 < 'CY01' DE 'TZ',
A3:: VAL A2+1 < 'CYRC' DE 'TZ',
A4:: VAL A3+1 < 'CZ01' DE 'TZ',
A5:: VAL A4+1 < 'CZUS' DE 'TZ'.
<
<
< L O C A L :
<
<
LOCAL
FLOC: EQU $
FTEMP: FLOAT 0
PROG
<
<
< C O M P O S A N T E E N ' U ' :
<
<
SPU: EQU $
LXI A1
BSR ASPCT < A1,
FST FTEMP
FLD VARU
BSR ACOS < COS(U),
FMP FTEMP < A1*COS(U),
FST FTEMP
FLD VARV
BSR ACOS < COS(V),
FMP FTEMP < A1*COS(U)*COS(V),
FST FTEMP
LXI A0
BSR ASPCT < A0,
FMP VARU < A0*U,
FAD FTEMP < A0*U+A1*COS(U)*COS(V).
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
LXI A3
BSR ASPCT < A3,
FST FTEMP
FLD VARU
BSR ASIN < SIN(U),
FMP FTEMP < A3*SIN(U),
FST FTEMP
FLD VARV
BSR ACOS < COS(V),
FMP FTEMP < A3*SIN(U)*COS(V),
FST FTEMP
LXI A2
BSR ASPCT < A2,
FMP VARV < A2*V,
FAD FTEMP < A2*V+A3*SIN(U)*COS(V).
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
LXI A5
BSR ASPCT < A5,
FST FTEMP
FLD VARV
BSR ASIN < SIN(V),
FMP FTEMP < A5*SIN(V),
FST FTEMP
LXI A4
BSR ASPCT < A4,
FMP VARV < A4*V,
FAD FTEMP < A4*V+A5*SIN(V).
RSR
:F
:F
< <<'SIOS COQUILLAGE 1'
DF'SIOS CYLINDRE 1'
ED'SIOS CYLINDRE 1'
IN0
PAGE
IDP "SIOS CYLINDRE 1"
<
<
< M I S E S U R U N C Y L I N D R E 1 :
< ( D ' A X E Z )
<
<
< EQUATION :
< X=A12*COS(A10*U+A11*V),
< Y=A13*SIN(A10*U+A11*V),
< Z=A14*V.
<
<
< NOTA :
< LE PARAMETRE 'A11' INTRODUIT
< UN DEPHASAGE SUR 'U' QUI PERMET
< AINSI DE TORDRE LE CYLINDRE.
<
<
< ARGUMENTS :
A10:: VAL '10
A11:: VAL A10+1
A12:: VAL A11+1
A13:: VAL A12+1
A14:: VAL A13+1
<
<
LOCAL
FLOC: EQU $
PREM: WORD 0 < INDICATEUR DE PREMIER TOUR...
<
< DEFINITION DU CYLINDRE :
<
XFA10: FLOAT 0 < 'A10',
XFA11: FLOAT 0 < 'A11',
XFA12: FLOAT 0 < 'A12',
XFA13: FLOAT 0 < 'A13',
XFA14: FLOAT 0 < 'A14'.
PROG
<
<
< C O M P O S A N T E ' X ' :
<
<
SPU: EQU $
<
< ENTREE DES PARAMETRES AU PREMIER TOUR :
<
CPZ PREM < EST-CE LE PREMIER TOUR ???
JG SPU1 < NON...
IC PREM < OUI, ON ENTRE LES PARAMETRES...
LXI A10
BSR ASPCT
FST XFA10
LXI A11
BSR ASPCT
FST XFA11
LXI A12
BSR ASPCT
FST XFA12
LXI A13
BSR ASPCT
FST XFA13
LXI A14
BSR ASPCT
FST XFA14
SPU1: EQU $
<
< CALCUL DE LA COMPOSANTE 'X' :
<
FLD VARU < U,
FMP XFA10 < A10*U,
FST FWORK
FLD VARV < V,
FMP XFA11 < A11*V,
FAD FWORK < A10*U+A11*V,
BSR ACOS < COS(A10*U+A11*V),
FMP XFA12 < X=A12*COS(A10*U+A11*V).
RSR
<
<
< C O M P O S A N T E ' Y ' :
<
<
SPV: EQU $
FLD VARU < U,
FMP XFA10 < A10*U,
FST FWORK
FLD VARV < V,
FMP XFA11 < A11*V,
FAD FWORK < A10*U+A11*V,
BSR ASIN < SIN(A10*U+A11*V),
FMP XFA13 < Y=A13*SIN(A10*U+A11*V).
RSR
<
<
< C O M P O S A N T E ' Z ' :
<
<
SPW: EQU $
FLD VARV < V,
FMP XFA14 < Z=A134V.
RSR
:F
:F
< <<'SIOS CYLINDRE 1'
DF'SIOS DIVERS 1'
ED'SIOS DIVERS 1'
IN0
PAGE
IDP "SIOS DIVERS 1"
<
<
< F O N C T I O N D I V E R S 1 :
<
<
< FONCTION :
< CE MODULE CALCULE LA FONCTION
< EXTRAVAGANTE SUIVANTE :
<
< X=A20*U+A21,
< Y=A22*V+A23,
< Z=A1F+A1E*(A1D+A0*Z1+A3*Z2+A6*Z3+A1C*Z4+A12*Z5+A17*Z6), AVE
< Z1=U*(A1*U2+A2*V2)+
< Z2=U*V/(A4*U2+A5*V2)**2 SI (U,V)#(0,0),
< =0 SI (U,V)=(0,0),
< Z3=MAX(A7*U+A8*V2,A9*U+AA*U2+AB*V2),
< Z4=AC*VP+AD*U2 SI VP>=-(AD/AC)*U2,
< =(AC*VP+AD*U2)*(AE*VP+AF*U2) SI -(AD/AC)*U2>=VP>=-(AF/
< AE)*U2,
< =A10*ABS(U)+A11*RAC(VP) SI (A10/A11)**2*U2>=VP>=0,
< AVEC : VP=ABS(V),
< Z5=U*V*((A13*U2+A14*V2)/(A15*U2+A16*V2)) SI (U,V)#(0,0),
< =0 SI (U,V)=(0,0),
< Z6=A18*COS(A19/U)+A1A*SIN(A1B/V), EN REMPLACANT LA FONC-
< TRIGONOMETRIQUE PAR 0 SI SON ARGUMENT EST INFINI...
<
<
< ARGUMENTS :
A00:: VAL 0
A01:: VAL A00+1
A02:: VAL A01+1
A03:: VAL A02+1
A04:: VAL A03+1
A05:: VAL A04+1
A06:: VAL A05+1
A07:: VAL A06+1
A08:: VAL A07+1
A09:: VAL A08+1
A0A:: VAL A09+1
A0B:: VAL A0A+1
A0C:: VAL A0B+1
A0D:: VAL A0C+1
A0E:: VAL A0D+1
A0F:: VAL A0E+1
A10:: VAL A0F+1
A11:: VAL A10+1
A12:: VAL A11+1
A13:: VAL A12+1
A14:: VAL A13+1
A15:: VAL A14+1
A16:: VAL A15+1
A17:: VAL A16+1
A18:: VAL A17+1
A19:: VAL A18+1
A1A:: VAL A19+1
A1B:: VAL A1A+1
A1C:: VAL A1B+1
A1D:: VAL A1C+1
A1E:: VAL A1D+1
A1F:: VAL A1E+1
A20:: VAL '20
A21:: VAL A20+1
A22:: VAL A21+1
A23:: VAL A22+1
<
<
< L O C A L :
<
<
LOCAL
FLOC: EQU $
PREM: WORD -1 < INDICATEUR DE PREMIER PASSAGE...
<
< RELAIS :
<
ASPU1: WORD SPU1 < POUR SAUTER L'ENTREE DES CONSTANTES...
ACUMUL: WORD CUMUL < CUMUL DE Z1, Z2, Z3, Z4, Z5 ET Z6...
<
< PARAMETRES :
<
XFA00: FLOAT 0
XFA01: FLOAT 0
XFA02: FLOAT 0
XFA03: FLOAT 0
XFA04: FLOAT 0
XFA05: FLOAT 0
XFA06: FLOAT 0
XFA07: FLOAT 0
XFA08: FLOAT 0
XFA09: FLOAT 0
XFA0A: FLOAT 0
XFA0B: FLOAT 0
XFA0C: FLOAT 0
XFA0D: FLOAT 0
XFA0E: FLOAT 0
XFA0F: FLOAT 0
XFA10: FLOAT 0
XFA11: FLOAT 0
XFA12: FLOAT 0
XFA13: FLOAT 0
XFA14: FLOAT 0
XFA15: FLOAT 0
XFA16: FLOAT 0
XFA17: FLOAT 0
XFA18: FLOAT 0
XFA19: FLOAT 0
XFA1A: FLOAT 0
XFA1B: FLOAT 0
XFA1C: FLOAT 0
XFA1D: FLOAT 0
XFA1E: FLOAT 0
XFA1F: FLOAT 0
XFA20: FLOAT 0
XFA21: FLOAT 0
XFA22: FLOAT 0
XFA23: FLOAT 0
<
< VARIABLES INTERMEDIAIRES :
<
VARVP: FLOAT 0 < VARVP=ABS(VARV).
FCUMUL: FLOAT 0 < VALEUR INTERMEDIAIRE DE 'Z'...
<
<
< C O M P O S A N T E E N ' U ' :
<
<
PROG
SPU: EQU $
CPZ PREM < PREMIER PASSAGE ???
JL SPU2 < ET OUI...
BR ASPU1 < NON...
<
< ENTREE DES PARAMETRES :
<
SPU2: EQU $
IC PREM < MEMORISATION DE CETTE INITIALISATION...
LXI A00
BSR ASPCT
FST XFA00
LXI A01
BSR ASPCT
FST XFA01
LXI A02
BSR ASPCT
FST XFA02
LXI A03
BSR ASPCT
FST XFA03
LXI A04
BSR ASPCT
FST XFA04
LXI A05
BSR ASPCT
FST XFA05
LXI A06
BSR ASPCT
FST XFA06
LXI A07
BSR ASPCT
FST XFA07
LXI A08
BSR ASPCT
FST XFA08
LXI A09
BSR ASPCT
FST XFA09
LXI A0A
BSR ASPCT
FST XFA0A
LXI A0B
BSR ASPCT
FST XFA0B
LXI A0C
BSR ASPCT
FST XFA0C
LXI A0D
BSR ASPCT
FST XFA0D
LXI A0E
BSR ASPCT
FST XFA0E
LXI A0F
BSR ASPCT
FST XFA0F
LXI A10
BSR ASPCT
FST XFA10
LXI A11
BSR ASPCT
FST XFA11
LXI A12
BSR ASPCT
FST XFA12
LXI A13
BSR ASPCT
FST XFA13
LXI A14
BSR ASPCT
FST XFA14
LXI A15
BSR ASPCT
FST XFA15
LXI A16
BSR ASPCT
FST XFA16
LXI A17
BSR ASPCT
FST XFA17
LXI A18
BSR ASPCT
FST XFA18
LXI A19
BSR ASPCT
FST XFA19
LXI A1A
BSR ASPCT
FST XFA1A
LXI A1B
BSR ASPCT
FST XFA1B
LXI A1C
BSR ASPCT
FST XFA1C
LXI A1D
BSR ASPCT
FST XFA1D
LXI A1E
BSR ASPCT
FST XFA1E
LXI A1F
BSR ASPCT
FST XFA1F
LXI A20
BSR ASPCT
FST XFA20
LXI A21
BSR ASPCT
FST XFA21
LXI A22
BSR ASPCT
FST XFA22
LXI A23
BSR ASPCT
FST XFA23
<
< CALCUL DE 'X' :
<
SPU1: EQU $
FLD VARU < U,
FMP XFA20 < A20*U,
FAD XFA21 < A20*U+A21.
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
FLD VARV < V,
FMP XFA22 < A22*V,
FAD XFA23 < A22*V+A23.
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
<
< INITIALISATION DU CUMUL :
<
FLD XFA1D
FST FCUMUL
<
< CALCUL DE Z1 :
<
FCMZ XFA00
JE SPW1 < INUTILE SI A0=0...
FLD VARU < U,
FMP VARU < U2,
FMP XFA01 < A1*U2,
BSR ASFWOR
FLD VARV < V,
FMP VARV < V2,
FMP XFA02 < A2*V2,
BSR APWORK < A1*U2+A2*V2,
FMP VARU < U*(A1*U2+A2*V2),
FMP XFA00 < A0*U*(A1*U2+A2*V2).
BSR ACUMUL
SPW1: EQU $
<
< CALCUL DE Z2 :
<
FCMZ XFA03
JE SPW2 < INUTILE SI A3=0...
FCMZ VARU
JNE SPW20 < IL FAUT CALCULER...
FCMZ VARV
JE SPW2 < INUTILE SI U=V=0...
SPW20: EQU $
FLD VARU < U,
FMP VARU < U2,
FMP XFA04 < A4*U2,
BSR ASFWOR
FLD VARV < V,
FMP VARV < V2,
FMP XFA05 < A5*V2,
BSR APWORK < A4*U2+A5*V2,
FLD VARU < U,
FMP VARV < U*V,
FDV FWORK < U*V/(A4*U2+A5*V2),
FMP XFA03 < A3*U*V/(A4*U2+A5*V2).
BSR ACUMUL
SPW2: EQU $
<
< CALCUL DE Z3 :
<
FCMZ XFA06
JE SPW3 < INITILE SI A6=0...
FLD VARU < U,
FMP XFA07 < A7*U,
BSR ASFWOR
FLD VARV < V,
FMP VARV < V2,
FMP XFA08 < A8*V2,
BSR APWORK < A7*U+A8*V2,
FST FWORK1 < ET SAVE...
FLD VARU < U,
FMP XFA0A < AA*U,
FAD XFA09 < A9+AA*U,
FMP VARU < A9*U+AA*U2,
BSR ASFWOR
FLD VARV < V,
FMP VARV < V2,
FMP XFA0B < AB*V2,
BSR APWORK < A9*U+AA*U2+AB*V2,
FCAM FWORK1 < CALCUL DU MAX(FWORK1,FWORK) :
JG SPW30 < FWORK>FWORK1...
FLD FWORK1 < C'EST FWORK1 LE MAX...
SPW30: EQU $
FMP XFA06 < A6*MAX(A7*U+A8*V2,
< A9*U+AA*U2+AB*V2).
BSR ACUMUL
SPW3: EQU $
<
< CALCUL DE Z4 :
<
FCMZ XFA0C
JE SPW4 < INUTILE SI AC=0...
FLD VARV < V,
BSR AFABS
FST VARVP < VP=ABS(V)...
FMP XFA0C < AC*VP,
BSR ASFWOR
FLD VARU < U,
FMP VARU < U2,
FMP XFA0D < AD*U2,
BSR APWORK < AC*VP+AD*U2,
BSR AFCAZ
JGE SPW40 < AC*VP+AD*U2>=0...
FST FWORK1 < SAVE...
FLD VARVP < VP,
FMP XFA0E < AE*VP,
BSR ASFWOR
FLD VARU < U,
FMP VARU < U2,
FMP XFA0F < AF*U2,
BSR APWORK < AE*VP+AF*U2,
BSR AFCAZ
JL SPW41 < NEGATIF, IL FAUT CHANGER D'EXPRESSION...
FMP FWORK1 < POSITIF OU NUL, ON FORME :
< (AC*VP+AD*U2)*(AE*VP+AF*U2)...
JMP SPW40 < VERS LA SORTIE...
SPW41: EQU $
FLD VARVP < VP,
BSR ARAC < RAC(VP),
FMP XFA11 < A11*RAC(VP),
BSR ASFWOR
FLD VARU < U,
BSR AFABS < ABS(U),
FMP XFA10 < A10*ABS(U),
BSR APWORK < A10*ABS(U)+A11*RAC(VP).
SPW40: EQU $
FMP XFA1C < A1C*(...).
BSR ACUMUL
SPW4: EQU $
<
< CALCUL DE Z5 :
<
FCMZ XFA12
JE SPW5 < INUTILE SI A12=0...
FCMZ VARU
JNE SPW50 < IL FAUT CALCULER...
FCMZ VARV
JE SPW5 < U=V=0, RIEN A FAIRE...
SPW50: EQU $
FLD VARU < U,
FMP VARU < U2,
FMP XFA15 < A15*U2,
BSR ASFWOR
FLD VARV < V,
FMP VARV < V2,
FMP XFA16 < A16*V2,
BSR APWORK < A15*U2+A16*V2,
FST FWORK1 < ET SAVE...
FLD VARU < U,
FMP VARU < U2,
FMP XFA13 < A13*U2,
BSR ASFWOR
FLD VARV < V,
FMP VARV < V2,
FMP XFA14 < A14*V2,
BSR APWORK < A13*U2+A14*V2,
FDV FWORK1 < (A13*U2+A14*V2)/(A15*U2+A16*V2),
FMP VARU < U*(A13*U2+A14*V2)/(A15*U2+A16*V2),
FMP VARV < U*V*(A13*U2+A14*V2)/(A15*U2+A16*V2),
FMP XFA12 < A12*U*V*(A13*U2+A14*V2)/(A15*U2+A16*V2).
BSR ACUMUL
SPW5: EQU $
<
< CALCUL DE Z6 :
<
FCMZ XFA17
JE SPW6 < INUTILE SI A17=0...
FLD F0
FCMZ VARU
JE SPW60 < PAS DE COS(A19/U) SI U=0...
FLD XFA19 < A19,
FDV VARU < A19/U,
BSR ACOS < COS(A19/U),
FMP XFA18 < A18*COS(A19/U),
SPW60: EQU $
FST FWORK1 < ET SAVE...
FLD F0
FCMZ VARV
JE SPW61 < PAS DE SIN(A1B/V) SI V=0...
FLD XFA1B < A1B,
FDV VARV < A1B/V,
BSR ASIN < SIN(A1B/V),
FMP XFA1A < A1A*SIN(A1B/V),
SPW61: EQU $
FAD FWORK1 < A18*COS(A19/U)+A1A*SIN(A1B/V),
FMP XFA17 < A17*(A18*COS(A19/U)+A1A*SIN(A1B/V)).
BSR ACUMUL
SPW6: EQU $
<
< CUMUL GENERAL :
<
FLD FCUMUL
FMP XFA1E < A1E*(...).
FAD XFA1F < A1F+A1E*(...).
RSR
<
<
< M O D U L E D E C U M U L :
<
<
CUMUL: EQU $
FAD FCUMUL
FST FCUMUL
RSR
:F
:F
< <<'SIOS DIVERS 1'
DF'SIOS HELICE Z'
ED'SIOS HELICE Z'
IN0
PAGE
IDP "SIOS HELICE Z"
<
<
< M I S E S U R U N E H E L I C E D ' A X E Z :
<
<
< EQUATION DE L'HELICE :
< X=A0*COS(U),
< Y=A0*SIN(U),
< Z=A1*U+A2*V.
<
<
LOCAL
FLOC: EQU $
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
FXWORK: FLOAT 0
PROG
<
<
< C O M P O S A N T E E N ' U ' :
<
<
SPU: EQU $
FLD VARU
BSR ACOS
FST FXWORK
LXI A0
BSR ASPCT
FMP FXWORK
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
FLD VARU
BSR ASIN
FST FXWORK
LXI A0
BSR ASPCT
FMP FXWORK
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
LXI A1
BSR ASPCT
FMP VARU
FST FXWORK
LXI A2
BSR ASPCT
FMP VARV
FAD FXWORK
RSR
:F
:F
< <<'SIOS HELICE Z'
DF'SIOS LEMNISCATE Z'
ED'SIOS LEMNISCATE Z'
IN0
PAGE
IDP "SIOS LEMNISCATE Z"
<
<
< M I S E S U R U N R U B A N E N F O R M E
< D E L E M N I S C A T E :
< ( D ' A X E Z )
<
<
< EQUATION :
< X=A0*(A3+A4*V*V)*RAC(2*COS(2*U))*COS(U),
< Y=A0*RAC(2*COS(2*U))*SIN(U),
< Z=A1*V.
< OU :
< X=A0*(A3+A4*V*V)**COS(U),
< Y=A0*COS(U)*SIN(U),
< Z=A1*V.
<
<
< PARAMETRES :
< A0=RACINE CARRE DE L'AIRE DE CHAQUE BOUCLE,
< A1=PAS DE DEPLACEMENT SUR L'AXE DES Z.
< A2=0 : SI COS(2*U)<0, ON LE REMPLACE PAR 0 (LEMNISCATE),
< =-1 : SI COS(2*U)<0, ON LE REMPLACE PAR -COS(2*U)
< (TREFLE A 4 FEUILLES).
< =+1 : ON NE PREND PAS LA RACINE CARREE...
< (CF. LA 2EME EQUATION)
<
<
LOCAL
FLOC: EQU $
XFRHO: FLOAT 0
FMOD: FLOAT 0 < MODE DE CALCUL :
< -1 : TREFLE A 4 FEUILLES,
< 0 : LEMNISCATE,
< +1 : BOUCLE.
FCOS: FLOAT 0
XXA0: FLOAT 0
XXMUL: FLOAT 0
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
A3:: VAL A2+1
A4:: VAL A3+1
PROG
<
<
< C O M P O S A N T E E N U :
<
<
SPU: EQU $
LXI A3
BSR ASPCT
FST FWORK < A3,
LXI A4
BSR ASPCT < A4,
FMP VARV < A4*V,
FMP VARV < A4*V*V,
FAD FWORK < A3+A4*V*V,
FST XXMUL < CE QUI DONNE LE FACTEUR MULTIPLICATIF.
LXI A2
BSR ASPCT
FST FMOD < CONSTANTE DE DISCRIMINATION DU TREFLE
< (-1), ET DU LEMNISCATE (0)...
LXI A0
BSR ASPCT
FCMZ FMOD < ALORS ???
JG SPU3 < BOUCLE...
FST XXA0
FLD VARU
FDV F05 < 2*U,
BSR ACOS < COS(2*U),
FDV F05 < 2*COS(2*U),
FCMZ FMOD < DOIT-ON PRENDRE LA RACINE CARREE ???
JG SPU2 < NON...
FCAZ
JGE SPU1
FMP FMOD
SPU1: EQU $
BSR ARAC < RAC(2*COS(2*U)),
SPU2: EQU $
FMP XXA0 < A0*RAC(2*COS(2*U)).
SPU3: EQU $
FST XFRHO
FLD VARU
BSR ACOS < COS(U),
FST FCOS < SAUVEGARDE DU COSINUS...
FMP XXMUL < *(A3+A4*V*V),
FMP XFRHO < CE QUI DONNE LA COMPOSANTE EN 'U'...
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
FLD VARU
BSR ASIN < SIN(U),
FMP XFRHO < CE QUI DONNE LA COMPOSANTE EN 'V'.
FCMZ FMOD < ALORS ???
JLE SPV1 < TREFLE A 4 FEUILLES OU LEMNISCATE...
FMP FCOS < BOUCLE...
SPV1: EQU $
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
LXI A1
BSR ASPCT
FMP VARV
RSR
:F
:F
< <<'SIOS LEMNISCATE Z'
DF'SIOS OEUF 1'
ED'SIOS OEUF 1'
IN0
PAGE
IDP "SIOS OEUF 1"
<
<
< M I S E S U R U N O E U F 1 :
<
<
< FONCTION :
< MET SUR LA SURFACE D'EQUATION :
<
< X=A9+AC*U+AD*V+A0*(A6+COS(U)*COS(V))**A1,
< Y=AA+AE*U+AF*V+A2*(A7+SIN(U)*COS(V))**A3,
< Z=AB+A10*U+A11*V+A4*(A8+SIN(V))**A5.
<
<
< ARGUMENTS :
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
A3:: VAL A2+1
A4:: VAL A3+1
A5:: VAL A4+1
A6:: VAL A5+1
A7:: VAL A6+1
A8:: VAL A7+1
A9:: VAL A8+1
AA:: VAL A9+1
AB:: VAL AA+1
AC:: VAL AB+1
AD:: VAL AC+1
AE:: VAL AD+1
AF:: VAL AE+1
A10:: VAL AF+1
A11:: VAL A10+1
<
<
LOCAL
FLOC: EQU $
<
< CONSTANTES :
<
PREM: WORD -1 < INDICATEUR DE PREMIER PASSAGE...
SIGNE: WORD 0 < POUR DONNER UN SIGNE A L'EXPRESSION
< X**Y, OU X ET Y SONT QUELCONQUES...
<
< PARAMETRES :
<
XFA0: FLOAT 0
XFA1: FLOAT 0
XFA2: FLOAT 0
XFA3: FLOAT 0
XFA4: FLOAT 0
XFA5: FLOAT 0
XFA6: FLOAT 0
XFA7: FLOAT 0
XFA8: FLOAT 0
XFA9: FLOAT 0
XFAA: FLOAT 0
XFAB: FLOAT 0
XFAC: FLOAT 0
XFAD: FLOAT 0
XFAE: FLOAT 0
XFAF: FLOAT 0
XFA10: FLOAT 0
XFA11: FLOAT 0
<
< RELAIS :
<
ALOGN: WORD LOGN < CALCUL DU LOGARITHME NEPERIEN.
AEXP: WORD EXP < CALCUL DE L'EXPONENTIELLE.
ASP1: WORD SP1 < POUR GENERER LE SIGNE...
<
< POUR LE CALCUL DU LOGARITHME :
<
ZZZ001: DZS 2 < NB FLOTTANT
ZZZ002: DZS 2
ZZZ003: DZS 2
ZZZ004: WORD '5A00;'8279 < RACINE(2)/2
ZZZ005: WORD '5201;'B046 < CSTES DU DEVELOPPEMENT
ZZZ006: WORD '5402;'79B7
ZZZ007: WORD '6A01;'0867
ZZZ008: WORD '4000;'0000 < CSTE 0.5
ZZZ009: WORD '5800;'B90C < CSTE LN(2)
<
< POUR LE CALCUL DE L'EXPONENTIELLE :
<
ZZZ010: WORD 'FF00 < MASQUE
ZZZ021: DZS 2 < NB EN FLOTTANT
ZZZ022: DZS 2
ZZZ023: DZS 2
ZZZ024: WORD '5C01;'551E < LOG A BASE 2 DE E
ZZZ025: DZS 1 < RELEVE DE L'EXPOSANT
ZZZ026: WORD '4001;'0000 < 1.0
ZZZ027: WORD '4002;'0000 < 2.0
ZZZ028: WORD '5707;'6AE1 < CSTES DU POLYNOME
ZZZ029: WORD '46FC;'FA70
ZZZ030: WORD 'BA0F;'5917
ZZZ031: WORD '4F04;'A303
ZZZ032: WORD 'FF00 < MASQUE
<
<
< C O M P O S A N T E E N ' U ' :
<
<
PROG
SPU: EQU $
<
< ENTREE DES PARAMETRES :
<
CPZ PREM < EST-CE NECESSAIRE ???
JGE SPU1 < NON...
IC PREM < OUI, ET ON LE MEMORISE...
LXI A0
BSR ASPCT
FST XFA0
LXI A1
BSR ASPCT
FST XFA1
LXI A2
BSR ASPCT
FST XFA2
LXI A3
BSR ASPCT
FST XFA3
LXI A4
BSR ASPCT
FST XFA4
LXI A5
BSR ASPCT
FST XFA5
LXI A6
BSR ASPCT
FST XFA6
LXI A7
BSR ASPCT
FST XFA7
LXI A8
BSR ASPCT
FST XFA8
LXI A9
BSR ASPCT
FST XFA9
LXI AA
BSR ASPCT
FST XFAA
LXI AB
BSR ASPCT
FST XFAB
LXI AC
BSR ASPCT
FST XFAC
LXI AD
BSR ASPCT
FST XFAD
LXI AE
BSR ASPCT
FST XFAE
LXI AF
BSR ASPCT
FST XFAF
LXI A10
BSR ASPCT
FST XFA10
LXI A11
BSR ASPCT
FST XFA11
<
< CALCUL DE 'X' :
<
SPU1: EQU $
FLD VARU < U,
BSR ACOS < COS(U),
FST FWORK
FLD VARV < V,
BSR ACOS < COS(V),
FMP FWORK < COS(U)*COS(V),
FAD XFA6 < A6+COS(U)*COS(V),
BSR ALOGN < LOG(A6+COS(U)*COS(V)),
PSR A,B < SAVE...
FLD XFA1
BSR ASP1 < PRISE EN COMPTE DE LA PARITE DE 'A1',
PLR A,B < ET RESTAURE...
FMP XFA1 < A1*LOG(A6+COS(U)*COS(V)),
BSR AEXP < (A6+COS(U)*COS(V))**A1,
FMP XFA0 < A0*(A6+COS(U)*COS(V))**A1,
FAD XFA9 < A9+A0*(A6+COS(U)*COS(V))**A1...
FST FWORK
FLD VARU < U,
FMP XFAC < AC*U,
FAD FWORK
FST FWORK
FLD VARV < V,
FMP XFAD < AD*V,
FAD FWORK < AC*U+AD*V+...
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
FLD VARU < U,
BSR ASIN < SIN(U),
FST FWORK
FLD VARV < V,
BSR ACOS < COS(V),
FMP FWORK < SIN(U)*COS(V),
FAD XFA7 < A7+SIN(U)*COS(V),
BSR ALOGN < LOG(A7+SIN(U)*COS(V)),
PSR A,B < SAVE...
FLD XFA3
BSR ASP1 < PRISE EN COMPTE DE LA PARITE DE 'A3',
PLR A,B < ET RESTAURE...
FMP XFA3 < A3*LOG(A7+SIN(U)*COS(V)),
BSR AEXP < (A7+SIN(U)*COS(V))**A3,
FMP XFA2 < A2*(A7+SIN(U)*COS(V))**A3,
FAD XFAA < AA+A2*(A7+SIN(U)*COS(V))**A3...
FST FWORK
FLD VARU < U,
FMP XFAE < AE*U,
FAD FWORK
FST FWORK
FLD VARV < V,
FMP XFAF < AF*V,
FAD FWORK < AE*U+AF*V+...
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
FLD VARV < V,
BSR ASIN < SIN(V),
FAD XFA8 < A8+SIN(V),
BSR ALOGN < LOG(A8+SIN(V)),
PSR A,B < SAVE...
FLD XFA5
BSR ASP1 < PRISE EN COMPTE DE LA PARITE DE 'A5',
PLR A,B < ET RESTAURE...
FMP XFA5 < A5*LOG(A8+SIN(V)),
BSR AEXP < (A8+SIN(V))**A5,
FMP XFA4 < A4*(A8+SIN(V))**A5,
FAD XFAB < AB+A4*(A8+SIN(V))**A5...
FST FWORK
FLD VARU < U,
FMP XFA10 < A10*U,
FAD FWORK
FST FWORK
FLD VARV < V,
FMP XFA11 < A11*V,
FAD FWORK < A10*U+A11*V+...
RSR
<
<
< L O G N E P E R I E N :
<
<
LOGN: EQU $
STZ SIGNE < =0 : SIGNE "+" A PRIORI...
FCAZ
JGE LOGN1 < POSITIF...
IC SIGNE < =1 : SIGNE "-"...
LOGN1: EQU $
LR A,Y
FABS
AND ZZZ010
FST ZZZ003
FAD ZZZ004
FST ZZZ002
LR Y,A
SWBR A
SARS 8
FLT
FST ZZZ001
FLD ZZZ003
FSB ZZZ004
FDV ZZZ002
FST ZZZ003
FMP ZZZ003
FNEG
FAD ZZZ007
FST ZZZ002
FLD ZZZ006
FDV ZZZ002
FAD ZZZ005
FMP ZZZ003
FSB ZZZ008
FAD ZZZ001
FMP ZZZ009
RSR
<
<
< E X P O N E N T I E L L E :
<
<
EXP: EQU $
FMP ZZZ024
FST ZZZ023
FIX
STA ZZZ025
FLT
FCAM ZZZ023
JNV ZZZ033
FLD ZZZ026
FST ZZZ023
JMP ZZZ035
ZZZ033: EQU $
CPZ ZZZ023
JGE ZZZ034
DC ZZZ025
LA ZZZ025
FLT
ZZZ034: EQU $
FSB ZZZ023
FNEG
FST ZZZ022
FMP ZZZ022
FST ZZZ021
FAD ZZZ028
FST ZZZ023
FLD ZZZ030
FDV ZZZ023
FAD ZZZ021
FMP ZZZ029
FAD ZZZ031
FSB ZZZ022
FST ZZZ023
FLD ZZZ027
FMP ZZZ022
FDV ZZZ023
FAD ZZZ026
FST ZZZ023
ZZZ035: EQU $
SWBR A
SARS 8
AD ZZZ025
CPI '7F
JG $
CPI -'80
JGE ZZZ036
LAI 0
RBT 8
LBI 0
JMP ZZZ037
ZZZ036: EQU $
ANDI 'FF
STA ZZZ025
LA ZZZ023
AND ZZZ032
AD ZZZ025
ZZZ037: EQU $
CPZ SIGNE < PRISE EN COMPTE DU SIGNE SIMULE :
JE EXP1 < POSITIF, ON LAISSE LE RESULTAT TEL QUEL..
FNEG < NEGATIF, ON INVERSE...
EXP1: EQU $
RSR
<
<
< T E S T D E L A " P A R I T E " D ' U N
< C O E F F I C I E N T :
<
<
SP1: EQU $
FABS < ON PREND LA VALEUR ABSOLUE,
BSR AROND < PUIS, LA PARTIE ENTIERE...
TBT NBITMO-1 < ET ON TESTE SA PARITE :
JC SP11 < IMPAIRE, 'SIGNE' RESTE INCHANGE...
STZ SIGNE < PAIRE, ON FAIT "+"...
SP11: EQU $
RSR
:F
:F
< <<'SIOS OEUF 1'
DF'SIOS PLAN SPHERE Z'
ED'SIOS PLAN SPHERE Z'
IN0
PAGE
IDP "SIOS PLAN SPHERE Z"
<
<
< M I S E S U R U N E S U R F A C E I N T E R P O L E E
< E N T R E U N P L A N E T U N E S P H E R E Z :
<
<
< EQUATION :
< X=A*U+C*COS(V)*COS(U),
< Y=B*V+C*COS(V)*SIN(U),
< Z=C*SIN(V).
<
<
< PARAMETRES :
XA:: VAL 0 < POIDS DU PLAN LE LONG DE L'AXE DES X,
XB:: VAL XA+1 < POIDS DU PLAN LE LONG DE L'AXE DES Y,
XC:: VAL XB+1 < POIDS DE LA SPHERE.
<
<
LOCAL
FLOC: EQU $
PROG
<
<
< C O M P O S A N T E ' U ' :
<
<
SPU: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ACOS
FMP FWORK
FST FWORK
LXI XC
BSR ASPCT
FMP FWORK
FST FWORK
LXI XA
BSR ASPCT
FMP VARU
FAD FWORK
RSR
<
<
< C O M P O S A N T E ' V ' :
<
<
SPV: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ASIN
FMP FWORK
FST FWORK
LXI XC
BSR ASPCT
FMP FWORK
FST FWORK
LXI XB
BSR ASPCT
FMP VARV
FAD FWORK
RSR
<
<
< C O M P O S A N T E ' W ' :
<
<
SPW: EQU $
FLD VARV
BSR ASIN
FST FWORK
LXI XC
BSR ASPCT
FMP FWORK
RSR
:F
:F
< <<'SIOS PLAN SPHERE Z'
DF'SIOS PLAN T SPHERE'
ED'SIOS PLAN T SPHERE'
IN0
PAGE
IDP "SIOS PLAN T SPHERE"
<
<
< M I S E S U R U N E S U R F A C E I N T E R P O L E E
< E N T R E U N P L A N T R A N S P O S E E T
< E T U N E S P H E R E D ' A X E Z :
<
<
< EQUATION :
< X=B*V+C*COS(V)*COS(U),
< Y=A*U+C*COS(V)*SIN(U),
< Z=C*SIN(V).
<
<
< PARAMETRES :
XA:: VAL 0 < POIDS DU PLAN LE LONG DE L'AXE DES Y,
XB:: VAL XA+1 < POIDS DU PLAN LE LONG DE L'AXE DES X,
XC:: VAL XB+1 < POIDS DE LA SPHERE.
<
<
LOCAL
FLOC: EQU $
PROG
<
<
< C O M P O S A N T E ' U ' :
<
<
SPU: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ACOS
FMP FWORK
FST FWORK
LXI XC
BSR ASPCT
FMP FWORK
FST FWORK
LXI XB
BSR ASPCT
FMP VARV
FAD FWORK
RSR
<
<
< C O M P O S A N T E ' V ' :
<
<
SPV: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ASIN
FMP FWORK
FST FWORK
LXI XC
BSR ASPCT
FMP FWORK
FST FWORK
LXI XA
BSR ASPCT
FMP VARU
FAD FWORK
RSR
<
<
< C O M P O S A N T E ' W ' :
<
<
SPW: EQU $
FLD VARV
BSR ASIN
FST FWORK
LXI XC
BSR ASPCT
FMP FWORK
RSR
:F
:F
< <<'SIOS PLAN T SPHERE'
DF'SIOS PSEUDO-SPHERE'
ED'SIOS PSEUDO-SPHERE'
IN0
PAGE
IDP "SIOS PSEUDO-SPHERE"
<
<
< M I S E S U R U N E P S E U D O - S P H E R E D ' A X E Z :
<
<
< FONCTION :
< PERMET, EN FAISANT VARIER
< 'P' DE 0 A 1, DE RETOURNER
< UNE SPHERE, EN DECHIRANT
< (MALHEUREUSEMENT...) SES 2
< POLES...
<
<
< EQUATION :
<
< (X) (R*COSV*COSU) (COSU*COSV -SINU -COSU*SINV) (F(P))
< (Y) = (R*COSV*SINU) - (SINU*COSV COSU -SINU*SINV) * (G(P))
< (Z) (R*SINV ) (SINV 0 COSV ) (H(P))
<
< (LA MATRICE DE ROTATION ETANT UNE
< MATRICE DE ROTATION 3D D'ANGLES U ET V ;
< ET F(P), G(P) ET H(P), ETANT LES COMPOSAN-
< TES D'UN DEPLACEMENT D'UN POINT (X,Y,Z)
< DE LA SPHERE REPERE DANS LE REFERENTIEL
< COMPOSE DU VECTEUR NORMAL ET DU PLAN
< TANGENT EN (X,Y,Z))
<
< X=R*COSV*COSU-COSU*COSV*F(P)+SINU*G(P)+COSU*SINV*H(P),
< Y=R*COSV*SINU-SINU*COSV*F(P)-COSU*G(P)+SINU*SINV*H(P),
< Z=R*SINV-SINV*F(P)-COSV*H(P).
<
< OU :
< U(L)=PI*L*L+U,
< V(L)=V*(1-2*L*L).
< ET :
< 'F', 'G' ET 'H' SONT TROIS FONCTIONS
< TELLES QUE :
< F(O)=G(0)=H(0)=0,
< F(1)=2*R, G(1)=H(1)=0.
<
<
< NOTA :
< POUR L=1, TOUT POINT OBTENU
< (X,Y,Z), EST LE SYMETRIQUE PAR
< RAPPORT AU CENTRE DE CELUI QUE
< L'ON OBTIENT POUR L=0 LORSQUE
< P=0 OU P=1...
<
<
< ARGUMENTS :
RAYON:: VAL 0 < 'R'=RAYON DE LA SPHERE...
LAMBDA:: VAL RAYON+1 < 'L'=PARAMETRE DE CALCUL DE U(L) ET V(L).
COEFP:: VAL LAMBDA+1 < 'P'=PARAMETRE DE MODULATION DES COORDON-
< NEES X, Y ET Z DANS (-1,+1).
<
<
LOCAL
FLOC: EQU $
<
< CONSTANTES :
<
PREM: WORD -1 < INDICATEUR DE PREMIER PASSAGE...
FRAYON: FLOAT 0 < RAYON DE LA SPHERE.
FLAMBD: FLOAT 0 < PARAMETRE DE CALCUL DE U(L) ET V(L).
FP: FLOAT 0 < PARAMETRE 'P'.
F2: FLOAT 2
F4: FLOAT 4
FCOSU: FLOAT 0 < COS(U(L)),
FSINU: FLOAT 0 < SIN(U(L)),
FCOSV: FLOAT 0 < COS(V(L)),
FSINV: FLOAT 0 < SIN(V(L)).
FWORK7: FLOAT 0 < VARIABLES
FWORK8: FLOAT 0 < DE
FWORK9: FLOAT 0 < TRAVAIL...
<
< RELAIS :
<
ASPUDL: WORD SPUDL < CALCUL DE U(L),
ASPVDL: WORD SPVDL < CALCUL DE V(L).
ASPTRI: WORD SPTRI < CALCUL DES 4 FONCTIONS TRIGONOMETRIQUES.
ASPFDP: WORD SPFDP < CALCUL DE F(P),
ASPGDP: WORD SPGDP < CALCUL DE G(P),
ASPHDP: WORD SPHDP < CALCUL DE H(P).
PROG
<
<
< C O M P O S A N T E ' U ' :
<
<
SPU: EQU $
<
< TEST DE PREMIER PASSAGE :
<
CPZ PREM < ALORS ???
JGE SPU1 < CAS DES PASSAGES SUIVANTS...
IC PREM < MEMORISATION DU PREMIER PASSAGE...
LXI RAYON
BSR ASPCT
FST FRAYON < ENTREE DU RAYON,
LXI LAMBDA
BSR ASPCT
FST FLAMBD < DE 'LAMBDA',
LXI COEFP
BSR ASPCT
FST FP < ET DE 'P'...
<
< CALCUL DE 'X' :
<
SPU1: EQU $
<
< CALCUL DE X=R*COSV*COSU :
<
BSR ASPTRI < CALCUL DES 4 FONCTIONS TRIGONOMETRIQUES.
FLD FRAYON < R,
FMP FCOSV < R*COSV,
FMP FCOSU < R*COSV*COSU,
BSR ASFWOR
<
< ROTATION (U,V) DE LA TRANSLATION F(P) :
<
BSR ASPFDP < F(P),
FMP FCOSU < COSU*F(P),
FMP FCOSV < COSU*COSV*F(P),
BSR AFNEG < -COSU*COSV*F(P),
BSR APWORK < R*COSV*COSU-COSU*COSV*F(P),
BSR ASPGDP < G(P),
FMP FSINU < SINU*G(P),
BSR APWORK < R*COSV*COSU-COSU*COSV*F(P)+SINU*G(P),
BSR ASPHDP < H(P),
FMP FCOSU < COSU*H(P),
FMP FSINV < COSU*SINV*H(P),
BSR APWORK < ...+COSU*SINV*H(P).
RSR
<
<
< C O M P O S A N T E ' V ' :
<
<
SPV: EQU $
<
< CALCUL DE 'Y' :
<
SPV1: EQU $
<
< CALCUL DE Y=R*COSV*SINU :
<
BSR ASPTRI < CALCUL DES 4 FONCTIONS TRIGONOMETRIQUES.
FLD FRAYON < R,
FMP FCOSV < R*COSV,
FMP FSINU < R*COSV*SINU,
BSR ASFWOR
<
< ROTATION (U,V) DE LA TRANSLATION G(P) :
<
BSR ASPFDP < F(P),
FMP FSINU < SINU*F(P),
FMP FCOSV < SINU*COSV*F(P),
BSR AFNEG < -SINU*COSV*F(P),
BSR APWORK < R*COSV*SINU-SINU*COSV*F(P),
BSR ASPGDP < G(P),
FMP FCOSU < COSU*G(P),
BSR AFNEG < -COSU*G(P),
BSR APWORK < R*COSV*SINU-SINU*COSV*F(P)-COSU*G(P),
BSR ASPHDP < H(P),
FMP FSINU < SINU*H(P),
FMP FSINV < SINU*SINV*H(P),
BSR APWORK < ...+SINU*SINV*H(P).
RSR
<
<
< C O M P O S A N T E ' W ' :
<
<
SPW: EQU $
<
< CALCUL DE 'Z' :
<
SPW1: EQU $
<
< CALCUL DE Z=R*SINV :
<
BSR ASPTRI < CALCUL DES 4 FONCTIONS TRIGONOMETRIQUES.
FLD FRAYON < R,
FMP FSINV < R*SINV,
BSR ASFWOR
<
< ROTATION (U,V) DE LA TRANSLATION H(P) :
<
BSR ASPFDP < F(P),
FMP FSINV < SINV*F(P),
BSR AFNEG < -SINV*F(P),
BSR APWORK < R*SINV-SINV*F(P),
BSR ASPHDP < H(P),
FMP FCOSV < COSV*H(P),
BSR AFNEG < -COSV*H(P),
BSR APWORK < R*SINV-SINV*F(P)-COSV*H(P).
RSR
<
<
< F O N C T I O N U ( L ) :
<
<
< FONCTION :
< POUR 'L' VARIANT DE 0 A 1,
< U(L) VARIE DE U A U+PI...
<
<
SPUDL: EQU $
FLD FLAMBD < L,
FMP FLAMBD < L*L,
FMP PI3141 < PI*L*L,
FAD VARU < PI*L*L+U.
RSR
<
<
< F O N C T I O N V ( L ) :
<
<
< FONCTION :
< POUR 'L' VARIANT DE 0 A 1,
< V(L) VARIE DE +V A -V...
<
<
SPVDL: EQU $
FLD FLAMBD < L,
FMP FLAMBD < L*L,
FMP F2 < 2*L*L,
BSR AFNEG < -2*L*L,
FAD F1 < 1-2*L*L,
FMP VARV < V*(1-2*L*L).
RSR
<
<
< C A L C U L D E S 4 F O N C T I O N S
< T R I G O N O M E T R I Q U E S :
<
<
SPTRI: EQU $
BSR ASPUDL < U(L),
PSR A,B
BSR ACOS < COS(U(L)).
FST FCOSU
PLR A,B < U(L),
BSR ASIN < SIN(U(L)).
FST FSINU
BSR ASPVDL < V(L),
PSR A,B
BSR ACOS < COS(V(L)).
FST FCOSV
PLR A,B < V(L),
BSR ASIN < SIN(V(L)).
FST FSINV
RSR
<
<
< C A L C U L D E F ( P ) :
<
<
< FONCTION :
< F(P)=2*R*P*P, TELLE QUE :
< F(0)=0,
< F(1)=2*R.
<
<
SPFDP: EQU $
FLD FRAYON < R,
FMP F2 < 2*R,
FMP FP < 2*R*P,
FMP FP < 2*R*P*P.
RSR
<
<
< C A L C U L D E G ( P ) :
<
<
< FONCTION :
< G(P)=P*(1-P), TELLE QUE :
< G(0)=G(1)=0.
<
<
SPGDP: EQU $
FLD F1 < 1,
FSB FP < 1-P,
FMP FP < P*(1-P).
RSR
<
<
< C A L C U L D E H ( P ) :
<
<
< FONCTION :
< H(P)=P*P*P*(1-P), TELLE QUE :
< H(0)=H(1)=0.
<
<
SPHDP: EQU $
FLD F1 < 1,
FSB FP < 1-P,
FMP FP < P*(1-P),
FMP FP < P*P*(1-P),
FMP FP < P*P*P*(1-P).
RSR
:F
:F
< <<'SIOS PSEUDO-SPHERE'
DF'SIOS SARDINE 1'
ED'SIOS SARDINE 1'
IN0
PAGE
IDP "SIOS SARDINE 1"
<
<
< M I S E S U R U N C O U V E R C L E D E
< B O I T E A S A R D I N E S 1 :
< ( D ' A X E Z )
<
<
< EQUATION :
< CE MODULE PERMET DE MAPPER SUR
< UNE SURFACE INTERPOLEE ENTRE LE
< PLAN ET UN COUVERCLE DE BOITE A
< SARDINE, UTILISANT UNE SPIRALE
< D'ARCHIMEDE :
<
< X=A00+A01*U+A02*V+(A03+A04*U+A05*V)*COS(A06+A07*U+A08*V),
< Y=A10+A11*U*A12*V+(A13+A14*U+A15*V)*SIN(A16+A17*U+A18*V),
< Z=A20+A21*U+A21*V.
<
<
< NOTA :
< LES PARAMETRES 'A09' ET 'A19' INTRODUISENT
< UN DEPHASAGE SUR 'U' QUI PERMET
< AINSI DE TORDRE LA BOITE A
< SARDINES.
<
<
< ARGUMENTS :
A00:: VAL '00
A01:: VAL A00+1
A02:: VAL A01+1
A03:: VAL A02+1
A04:: VAL A03+1
A05:: VAL A04+1
A06:: VAL A05+1
A07:: VAL A06+1
A08:: VAL A07+1
A10:: VAL '10
A11:: VAL A10+1
A12:: VAL A11+1
A13:: VAL A12+1
A14:: VAL A13+1
A15:: VAL A14+1
A16:: VAL A15+1
A17:: VAL A16+1
A18:: VAL A17+1
A20:: VAL '20
A21:: VAL A20+1
A22:: VAL A21+1
<
<
LOCAL
FLOC: EQU $
PREM: WORD 0 < INDICATEUR DE PREMIER TOUR...
<
< DEFINITION DU COUVERCLE DE BOITE A SARDINES :
<
XFA00: FLOAT 0
XFA01: FLOAT 0
XFA02: FLOAT 0
XFA03: FLOAT 0
XFA04: FLOAT 0
XFA05: FLOAT 0
XFA06: FLOAT 0
XFA07: FLOAT 0
XFA08: FLOAT 0
XFA10: FLOAT 0
XFA11: FLOAT 0
XFA12: FLOAT 0
XFA13: FLOAT 0
XFA14: FLOAT 0
XFA15: FLOAT 0
XFA16: FLOAT 0
XFA17: FLOAT 0
XFA18: FLOAT 0
XFA20: FLOAT 0
XFA21: FLOAT 0
XFA22: FLOAT 0
PROG
<
<
< C O M P O S A N T E ' X ' :
<
<
SPU: EQU $
<
< ENTREE DES PARAMETRES AU PREMIER TOUR :
<
CPZ PREM < EST-CE LE PREMIER TOUR ???
JG SPU1 < NON...
IC PREM < OUI, ON ENTRE LES PARAMETRES...
LXI A00
BSR ASPCT
FST XFA00
LXI A01
BSR ASPCT
FST XFA01
LXI A02
BSR ASPCT
FST XFA02
LXI A03
BSR ASPCT
FST XFA03
LXI A04
BSR ASPCT
FST XFA04
LXI A05
BSR ASPCT
FST XFA05
LXI A06
BSR ASPCT
FST XFA06
LXI A07
BSR ASPCT
FST XFA07
LXI A08
BSR ASPCT
FST XFA08
LXI A10
BSR ASPCT
FST XFA10
LXI A11
BSR ASPCT
FST XFA11
LXI A12
BSR ASPCT
FST XFA12
LXI A13
BSR ASPCT
FST XFA13
LXI A14
BSR ASPCT
FST XFA14
LXI A15
BSR ASPCT
FST XFA15
LXI A16
BSR ASPCT
FST XFA16
LXI A17
BSR ASPCT
FST XFA17
LXI A18
BSR ASPCT
FST XFA18
LXI A20
BSR ASPCT
FST XFA20
LXI A21
BSR ASPCT
FST XFA21
LXI A22
BSR ASPCT
FST XFA22
SPU1: EQU $
<
< CALCUL DE LA COMPOSANTE 'X' :
<
FLD XFA00 < A00,
BSR ASFWOR
FLD VARU < U,
FMP XFA01 < A01*U,
BSR APWORK < A00+A01*U,
FLD VARV < V,
FMP XFA02 < A02*V,
BSR APWORK < A00+A01*U+A02*V,
PSR A,B < ET SAVE...
FLD XFA06 < A06,
BSR ASFWOR
FLD VARU < U,
FMP XFA07 < A07*U,
BSR APWORK < A06+A07*U,
FLD VARV < V,
FMP XFA08 < A08*V,
BSR APWORK < A06+A07*U+A08*V,
BSR ACOS < COS(A06+A07*U+A08*V),
FST FWORK1 < COS(A06+A07*U+A08*V),
FLD XFA03 < A03,
BSR ASFWOR
FLD VARU < U,
FMP XFA04 < A04*U,
BSR APWORK < A03+A04*U,
FLD VARV < V,
FMP XFA05 < A05*V,
BSR APWORK < A03+A04*U+A05*V,
FMP FWORK1 < (A03+A04*U+A05*V)*COS(A06+A07*U+A08*V),
BSR ASFWOR
PLR A,B < A00+A01*U+A02*V,
BSR APWORK < A00+A01*U+A02*V+(A03+A04*U+A05*V)*
< COS(A06+A07*U+A07*V).
RSR
<
<
< C O M P O S A N T E ' Y ' :
<
<
SPV: EQU $
FLD XFA10 < A10,
BSR ASFWOR
FLD VARU < U,
FMP XFA11 < A11*U,
BSR APWORK < A10+A11*U,
FLD VARV < V,
FMP XFA12 < A12*V,
BSR APWORK < A10+A11*U+A12*V,
PSR A,B < ET SAVE...
FLD XFA16 < A16,
BSR ASFWOR
FLD VARU < U,
FMP XFA17 < A17*U,
BSR APWORK < A16+A17*U,
FLD VARV < V,
FMP XFA18 < A18*V,
BSR APWORK < A16+A17*U+A18*V,
BSR ASIN < SIN(A16+A17*U+A18*V),
FST FWORK1 < SIN(A16+A17*U+A18*V),
FLD XFA13 < A13,
BSR ASFWOR
FLD VARU < U,
FMP XFA14 < A14*U,
BSR APWORK < A13+A14*U,
FLD VARV < V,
FMP XFA15 < A15*V,
BSR APWORK < A13+A14*U+A15*V,
FMP FWORK1 < (A13+A14*U+A15*V)*SIN(A16+A17*U+A18*V),
BSR ASFWOR
PLR A,B < A10+A11*U+A12*V,
BSR APWORK < A10+A11*U+A12*V+(A13+A14*U+A15*V)*
< SIN(A16+A17*U+A18*V).
RSR
<
<
< C O M P O S A N T E ' Z ' :
<
<
SPW: EQU $
FLD XFA20 < A20,
BSR ASFWOR
FLD VARU < U,
FMP XFA21 < A21*U,
BSR APWORK < A20+A21*U,
FLD VARV < V,
FMP XFA22 < A22*V,
BSR APWORK < A20+A21*U+A22*V,
RSR
:F
:F
< <<'SIOS SARDINE 1'
DF'SIOS SPHERE BOY 1'
ED'SIOS SPHERE BOY 1'
IN0
PAGE
IDP "SIOS SPHERE BOY 1"
<
<
< M I S E S U R U N E S U R F A C E P L A N E T E
< I N T E R P O L E E E N T R E U N E S P H E R E
< E T U N E B O Y 1 :
<
<
< EQUATION :
< A(MU)=A6+A7*SIN(2*A9*MU-PI/3)+A8*SIN(A9*MU-PI/6),
< B(MU)=A6+A7*SIN(2*A9*MU-PI/3)-A8*SIN(A9*MU-PI/6),
< ALPHA=(PI/8)*SIN(A9*MU),
< X1=(A*A-B*B)/RAC(A*A+B*B)+A*COS(TETA)-B*SIN(TETA),
< Z1=RAC(A*A+B*B)+A*COS(TETA)+B*SIN(TETA),
< X=(X1*COS(MU)-Z1*SIN(ALPHA)*SIN(MU))*(A5+A0*F(XR,YR))*A10
< +(COS(V)*COS(U)*(A5+A0*F(XR,YR)))*A11+A1,
< Y=(X1*SIN(MU)+Z1*SIN(ALPHA)*COS(MU))*(A5+A0*F(XR,YR))*A10
< +(COS(V)*SIN(U)*(A5+A0*F(XR,YR)))*A11+A2,
< Z=(Z1*COS(ALPHA))*(A5+A0*F(XR,YR))*A10
< +(SIN(V)*(A5+A0*F(XR,YR)))*A11.
< OU :
< A0000=FACTEUR D'AMPLIFICATION DE L'EXTENSION
< F(XR,YR) DU RAYON.
< A0001=DEPLACEMENT SUR L'AXE DES X,
< A0002=DEPLACEMENT SUR L'AXE DES Y,
< A0003=NOMBRE DE POINTS DE LA SPIRALE.
< A0004=PAS DE PARCOURS DE LA SPIRALE (1 EN GENERAL).
< A0005=VALEUR MINIMALE DU RAYON.
< TETA=U, ET VARIE SUR (0,2*PI),
< MU=V, ET VARIE SUR (0,PI),
< A0006=PARAMETRE 'A6',
< A0007=PARAMETRE 'A7',
< A0008=PARAMETRE 'A8',
< A0009=PARAMETRE 'A9'.
< A000A=PARAMETRE 'A10' (POIDS DE LA BOY),
< A000B=PARAMETRE 'A11' (POIDS DE LA SPHERE).
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
A3:: VAL A2+1
A4:: VAL A3+1
A5:: VAL A4+1
A6:: VAL A5+1
A7:: VAL A6+1
A8:: VAL A7+1
A9:: VAL A8+1
A10:: VAL A9+1
A11:: VAL A10+1
<
<
LOCAL
FLOC: EQU $
<
< VARIABLES MONTAGNEUSES :
<
CUMUL: WORD 0 < SIGMA(NIVEAU(XS,YS)).
PASQ: WORD 0 < ARGUMENT 'A4'.
DELTAX: WORD 0
DELTAY: WORD 0
LB: WORD 0 < LONGUEUR DES
LB0: WORD 0 < BRANCHES DE LA SPIRALE.
NP: WORD 0 < NOMBRE DE POINT COURANT,
NPM: WORD 0 < NOMBRE DE POINTS ENTIER DE LA SPIRALE.
FNP: FLOAT 0 < NOMBRE DE POINTS FLOTTANT DE LA SPIRALE.
GXS: FLOAT 0 < COORDONNEES ABSOLUES
GYS: FLOAT 0 < DE CE POINT...
GINCU: FLOAT 0 < RESIDU DE L'ABSCISSE,
GINCV: FLOAT 0 < RESIDU DE L'ORDONNEE.
GNIV1: FLOAT 0 < SIGMA PONDERE DES NIVEAUX DE LA SPIRALE
< CENTREE EN (XS,YS),
GNIV2: FLOAT 0 < DE MEME EN (XS+1,YS),
GNIV3: FLOAT 0 < DE MEME EN (XS+1,YS+1),
GNIV4: FLOAT 0 < DE MEME EN (XS,YS+1).
PREM: WORD 0 < INDICATEUR DE PREMIER PASSAGE.
FA0: FLOAT 0 < CONSTANTE 'A0',
FA5: FLOAT 0 < ET 'A5'.
<
< VARIABLES DE MANOEUVRE DE BOY :
<
WXF1: FLOAT 0 < A8*SIN(A9*MU-PI/6), RAC(A*A+B*B), SIN(MU)
WXF2: FLOAT 0 < A*COS(TETA), COS(MU).
WXF3: FLOAT 0 < B*SIN(TETA), Z1*SIN(ALPHA).
WXF4: FLOAT 0 < A*A, Z1*SIN(ALPHA)*SIN(MU),
< Z1*SIN(ALPHA)*COS(MU).
WXF5: FLOAT 0 < B*B.
XFA: FLOAT 0 < A.
XFB: FLOAT 0 < B.
XALPHA: FLOAT 0 < ALPHA.
XX1: FLOAT 0 < X1.
XZ1: FLOAT 0 < Z1.
<
< PARAMETRES DE BOY :
<
XF10: FLOAT 10 < A6.
XF141: FLOAT 1.41 < A7.
XF198: FLOAT 1.98 < A8.
XF3: FLOAT 3 < ARGUMENT 'A9'.
PI: EQU PI3141
XF8: FLOAT 8
XFPI6: FLOAT 0.5235987 < PI/6.
XFA1: FLOAT 0 < DEPLACEMENT SUR L'AXE DES X,
XFA2: FLOAT 0 < ET SUR L'AXE DES Y.
<
< INTERPOLATION SPHERE-BOY :
<
YFAR: FLOAT 1 < POUR MEMORISER A5+A0*F(XR,YR).
< =1, AU CAS OU A0003=0 ==> PAS DE SPIRALE.
YFAU: FLOAT 0 < POUR MEMORISER
YFAV: EQU YFAU < DES VALEURS
YFAW: EQU YFAU < INTERMEDIAIRES
XFA10: FLOAT 0
XFA11: FLOAT 0
<
< PARAMETRES :
<
TETA: EQU VARU
MU: EQU VARV
<
< SOUS-PROGRAMMES :
<
ASP1: WORD SP1 < CALCUL DES VALEURS UTILES...
ASPIR: WORD SPIR < CALCUL DU SIGMA SUR UNE SPIRALE...
ARAYON: WORD RAYON < CALCUL DE LA FONCTION COURANTE.
ARAYO1: WORD RAYON1 < RELAI...
PROG
<
<
< C A L C U L D E S P A R A M E T R E S :
<
<
SP1: EQU $
<
< CALCUL DES VALEURS UTILISEES POUR
< LES 3 COMPOSANTES :
<
FLD MU
FMP XF3
FSB XFPI6
PSR A,B < A9*MU-PI/6,
BSR ASIN < SIN(A9*MU-PI/6),
FMP XF198
FST WXF1 < A8*SIN(A9*MU-PI/6).
PLR A,B < A9*MU-PI/6,
FDV F05 < 2*A9*MU-PI/3,
BSR ASIN < SIN(2*A9*MU-PI/3),
FMP XF141 < A7*SIN(2*A9*MU-PI/3),
FAD XF10 < A6+A7*SIN(2*A9*MU-PI/3),
PSR A,B
FAD WXF1
FST XFA < A=A6+A7*SIN(2*A9*MU-PI/3)+A8*SIN(A9*MU-PI
PLR A,B < A6+A7*SIN(2*A9*MU-PI/3),
FSB WXF1
FST XFB < B=A6+A7*SIN(2*A9*MU-PI/3)-A8*SIN(A9*MU-PI
FLD MU
FMP XF3
BSR ASIN
FMP PI
FDV XF8
FST XALPHA < ALPHA=(PI/8)*SIN(A9*MU).
FLD TETA
BSR ACOS
FMP XFA
FST WXF2 < A*COS(TETA).
FLD TETA
BSR ASIN
FMP XFB
FST WXF3 < B*SIN(TETA).
FLD XFA
FMP XFA
FST WXF4 < A*A.
FLD XFB
FMP XFB
FST WXF5 < B*B.
FAD WXF4 < A*A+B*B,
BSR ARAC
FST WXF1 < RAC(A*A+B*B).
FLD WXF4
FSB WXF5 < A*A-B*B,
FDV WXF1 < (A*A-B*B)/RAC(A*A+B*B),
FAD WXF2
FSB WXF3
FST XX1 < X1=(A*A-B*B)/RAC(A*A+B*B)+
< A*COS(TETA)-B*SIN(TETA).
FLD WXF1 < RAC(A*A+B*B),
FAD WXF2
FAD WXF3
FST XZ1 < Z1=RAC(A*A+B*B)+A*COS(TETA)+B*SIN(TETA).
FLD MU
BSR ASIN
FST WXF1 < SIN(MU).
FLD MU
BSR ACOS
FST WXF2 < COS(MU).
FLD XALPHA
BSR ASIN
FMP XZ1
FST WXF3 < Z1*SIN(ALPHA).
RSR
<
<
< C O O R D O N N E E E N ' U ' :
<
<
SPU: EQU $
<
< EST-CE LE PREMIER PASSAGE ???
<
CPZ PREM < ???
JG SPU1 < NON...
IC PREM < OUI, ON FAIT DES INITIALISATIONS...
<
< DEFINITION DE LA SURFACE DE BOY :
<
LXI A6
BSR ASPCT
FST XF10
LXI A7
BSR ASPCT
FST XF141
LXI A8
BSR ASPCT
FST XF198
LXI A9
BSR ASPCT
FST XF3
<
< AMPLIFICATEUR DE LA VARIATION DU RAYON
< ET VALEUR MINIMALE DE CELUI-CI :
<
LXI A0
BSR ASPCT
FST FA0
LXI A5
BSR ASPCT
FST FA5
<
< DEFINITION DE LA SPIRALE :
<
LXI A3
BSR ASPCT
FST FNP
FIX
STA NPM < NOMBRE DE POINTS MAX...
JAL $ < ??!??!?!
LXI A4
BSR ASPCT
BSR AROND
STA PASQ < PAS DE PARCOURS...
<
< TRANSLATION SUR OX ET OY :
<
LXI A1
BSR ASPCT
FST XFA1
LXI A2
BSR ASPCT
FST XFA2
<
< POIDS RESPECTIF SPHERE/BOY :
<
LXI A10
BSR ASPCT
FST XFA10 < POIDS DE LA BOY.
LXI A11
BSR ASPCT
FST XFA11 < POIDS DE LA SPHERE.
<
< CALCUL DE LA COMPOSANTE :
<
SPU1: EQU $
BSR ASP1 < CALCUL DES PARAMETRES ; RENVOIE :
< Z1*SIN(ALPHA).
FMP WXF1 < Z1*SIN(ALPHA)*SIN(MU),
FST WXF4
FLD WXF2 < COS(MU),
FMP XX1 < X1*COS(MU),
FSB WXF4 < X=X1*COS(MU)-Z1*SIN(ALPHA)*SIN(MU).
BSR ARAYON < MODULATION MONTAGNEUSE...
FMP XFA10 < PONDERATION,
FST YFAU < ET SAVE,
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ACOS
FMP FWORK < COS(U)*COS(V),
FMP YFAR < MODULATION MONTAGNEUSE,
FMP XFA11 < PONDERATION,
FAD YFAU < ET INTERPOLATION SPHERE-BOY...
FAD XFA1 < ET TRANSLATION.
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
BSR ASP1 < CALCUL DES PARAMETRES ; RENVOIE :
< Z1*SIN(ALPHA),
FMP WXF2 < Z1*SIN(ALPHA)*COS(MU),
FST WXF4
FLD WXF1 < SIN(MU),
FMP XX1 < X1*SIN(MU),
FAD WXF4 < Y=X1*SIN(MU)+Z1*SIN(ALPHA)*COS(MU).
BSR ARAYON < MODULATION MONTAGNEUSE...
FMP XFA10 < PONDERATION,
FST YFAV < ET SAVE,
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ASIN
FMP FWORK < SIN(U)*COS(V),
FMP YFAR < MODULATION MONTAGNEUSE,
FMP XFA11 < PONDERATION,
FAD YFAV < ET INTERPOLATION SPHERE-BOY...
FAD XFA2 < ET TRANSLATION.
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
BSR ASP1 < CALCUL DES PARAMETRES...
FLD XALPHA
BSR ACOS
FMP XZ1 < Z=Z1*COS(ALPHA).
BSR ARAYON < MODULATION MONTAGNEUSE...
FMP XFA10 < PONDERATION,
FST YFAW < ET SAVE,
FLD VARV
BSR ASIN < SIN(V),
FMP YFAR < MODULATION MONTAGNEUSE,
FMP XFA11 < PONDERATION,
FAD YFAW < ET INTERPOLATION SPHERE-BOY...
RSR
<
<
< C A L C U L D U R A Y O N :
<
<
< ARGUMENT :
< (A,B)=FONCTION COURANTE.
<
<
< RESULTAT :
< (A,B)=(CONSTANTE5+F(XR,YR))*(FONCTION COURANTE).
<
<
RAYON: EQU $
CPZ NPM < LA SPIRALE EST-ELLE VIDE ???
JG RAYON2 < NON, ON VA L'EXPLORER...
BR ARAYO1 < OUI, RIEN A FAIRE...
RAYON2: EQU $
PSR A,B < SAVE LE CUMUL INITIAL...
<
< CALCUL DU POINT COURANT ET
< POSITION DANS UN CARRE DE
< COORDONNEES ENTIERES :
<
FLD VARU
FDV KFU
FDV KUZ
FST FWORK
LA TRX
FLT
FAD FWORK
FST GXS < COORDONNEE 'XS' DU POINT COURANT,
FIX
STA XS < COORDONNEE 'X' DU PREMIER SOMMET,
FLT
FSB GXS
FNEG
FST GINCU < POSITION SUR L'AXE DES 'X',
FLD VARV
FDV KFV
FDV KVZ
FST FWORK
LA TRY
FLT
FAD FWORK
FST GYS < COORDONNEE 'YS' DU POINT COURANT.
FIX
STA YS < COORDONNEE 'Y' DU PREMIER SOMMET,
FLT
FSB GYS
FNEG
FST GINCV < POSITION SUR L'AXE DES 'Y'.
<
< PASSAGE SUR 'TV2' :
<
LA CTCDA
STA XCTCDA
<
< CALCUL DES NIVEAUX DES 4 SOMMETS :
<
BSR ASPIR
FST GNIV1 < NIVEAU(XS,YS).
IC XS
BSR ASPIR
FST GNIV2 < NIVEAU(XS+1,YS).
IC YS
BSR ASPIR
FST GNIV3 < NIVEAU(XS+1,YS+1).
DC XS
BSR ASPIR
FST GNIV4 < NIVEAU(XS,YS+1).
DC YS < RETOUR AU POINT DE DEPART...
<
< CALCUL DU NIVEAU INTERPOLE
< DANS LE CARRE "ENTIER" :
<
FLD F1
FSB GINCU
FST FWORK1 < W1=1-FU,
FLD F1
FSB GINCV
FST FWORK2 < W2=1-FV,
FMP FWORK1
FMP GNIV1
FST FWORK < (1-FU)*(1-FV)*N1,
FLD GINCU
FMP FWORK2
FMP GNIV2
FAD FWORK
FST FWORK < +FU*(1-FV)*N2,
FLD GINCU
FMP GINCV
FMP GNIV3
FAD FWORK
FST FWORK < +FU*FV*N3,
FLD FWORK1
FMP GINCV
FMP GNIV4
FAD FWORK < +(1-FU)*FV*N4,
<
< CALCUL DE LA FONCTION COURANTE :
<
FMP FA0 < AMPLIFICATION,
FAD FA5 < ET TRANSLATION.
FST YFAR < RAYON=FA5+FA0*F(XR,YR).
PLR A,B < RESTAURATION DU CUMUL,
FMP YFAR < ET CALCUL DE LA FONCTION COURANTE...
<
< RETOUR :
<
STZ XCTCDA < POUR ATTEINDRE 'TV1'...
RAYON1: EQU $
RSR
<
<
< S O M M A T I O N S U R U N E S P I R A L E
< C E N T R E E S U R ( X S , Y S ) D E S
< N I V E A U X D E S E S P O I N T S :
<
<
SPIR: EQU $
<
< INITIALISATION DE LA SPIRALE :
<
LA XS
LB YS
PSR A,B < SAUVEGARDE DU POINT (XS,YS).
STZ CUMUL < CUMUL <-- 0.
STZ NP < NP=NOMBRE DE POINTS TRAITES.
LA PASQ
STA DELTAX < DELTAX <-- +1,
STZ DELTAY < DELTAY <-- 0.
LAI 1
STA LB0 < INITIALISATION DE LA LONGUEUR DU
< PREMIER BRAS DE LA SPIRALE.
SPMOY8: EQU $
<
< PARCOURS D'UN BRAS :
<
SPMOY1: EQU $
LA LB0
STA LB < LONGUEUR DU BRAS COURANT.
<
< TRAITEMENT DU POINT COURANT :
<
SPMOY2: EQU $
IC NP < COMPTAGE DES POINTS TRAITES :
LA NP
CP NPM < FINI ???
JG SPMOY3 < OUI...
LA XS < NON :
LB YS
PSR A,B < SAVE (XS,YS) AVANT LE TORE EVENTUEL...
CPZ MODX < Y-A-T'IL X-TORE ???
JE SPMOY6 < OUI...
JAL SPMOY4 < NON, LE POINT EST HORS-ECRAN...
CPI NPOLM1
JG SPMOY4 < HORS-ECRAN...
SPMOY6: EQU $
ANDI NPOLM1 < CALCUL MODULO...
STA XS < MISE A JOUR DE XS.
LR B,A < (A)=YS,
CPZ MODY < EST-ON SUR UN Y-TORE ???
JE SPMOY7 < OUI...
JAL SPMOY4 < NON, LE POINT EST HORS-ECRAN...
CPI NLIGM1
JG SPMOY4 < HORS-ECRAN...
SPMOY7: EQU $
ANDI NLIGM1 < CALCUL MODULO...
STA YS < MISE A JOUR DE YS.
BSR ASPGPS < A=NIVEAU(XS,YS),
AD CUMUL < ET
STA CUMUL < CUMULE...
SPMOY4: EQU $
PLR A,B < (A)=XS,
< (B)=YS.
AD DELTAX < CHANGEMENT DE
STA XS
LR B,A < (A)=YS.
AD DELTAY < POINT COURANT (XS,YS).
STA YS
DC LB < DECOMPTAGE DES POINTS SUR LA BRANCHE :
JG SPMOY2 < OK, IL EN RESTE...
CPZ DELTAX < NON, ON EST AU BOUT, FAUT-IL AUGMENTER
< LA LONGUEUR COURANTE DES BRANCHES ???
JNE SPMOY5 < NON (DX#0) ...
IC LB0 < OUI (DX=0) ...
SPMOY5: EQU $
LA DELTAY < ON FAIT SUBIR AU NOMBRE COMPLEXE
NGR A,A < (DX,DY) UNE ROTATION DE PI/2, SOIT
LB DELTAX < UNE MULTIPLICATION PAR LA MATRICE
< (0,-1,1,0)...
STA DELTAX < DELTAX=-DELTAY,
STB DELTAY < DELTAY=DELTAX.
JMP SPMOY1 < VERS LA BRANCHE SUIVANTE
<
< GENERATION DU POINT (XS,YS) :
<
SPMOY3: EQU $
PLR A,B
STA XS < RESTAURATION
STB YS < DE (XS,YS),
<
< NORMALISATION DU CUMUL :
<
LA CUMUL
FLT
FDV FNP
RSR
:F
:F
< <<'SIOS SPHERE BOY 1'
DF'SIOS SPHERE Y'
ED'SIOS SPHERE Y'
IN0
PAGE
IDP "SIOS SPHERE Y"
<
<
< M I S E S U R U N E S P H E R E D ' A X E Y :
<
<
< EQUATION :
< X=R*COS(V)*COS(U),
< Y=R*SIN(V),
< Z=R*COS(V)*SIN(U).
< OU :
< 'R' EST LA CONSTANTE PROGRAMMABLE 'A 0000'.
<
<
LOCAL
FLOC: EQU $
RAYON:: VAL 0
PROG
<
<
< C O M P O S A N T E ' U ' :
<
<
SPU: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ACOS
FMP FWORK
FST FWORK
LXI RAYON
BSR ASPCT < ACCES AU RAYON.
FMP FWORK
RSR
<
<
< C O M P O S A N T E ' V ' :
<
<
SPV: EQU $
FLD VARV
BSR ASIN
FST FWORK
LXI RAYON
BSR ASPCT
FMP FWORK
RSR
<
<
< C O M P O S A N T E ' W ' :
<
<
SPW: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ASIN
FMP FWORK
FST FWORK
LXI RAYON
BSR ASPCT
FMP FWORK
RSR
:F
:F
< <<'SIOS SPHERE Y'
DF'SIOS SPHERE Z'
ED'SIOS SPHERE Z'
IN0
PAGE
IDP "SIOS SPHERE Z"
<
<
< M I S E S U R U N E S P H E R E D ' A X E Z :
<
<
< EQUATION :
< X=R*COS(V)*COS(U),
< Y=R*COS(V)*SIN(U),
< Z=R*SIN(V).
< OU :
< 'R' EST LA CONSTANTE PROGRAMMABLE 'A 0000'.
<
<
LOCAL
FLOC: EQU $
RAYON:: VAL 0
PROG
<
<
< C O M P O S A N T E ' U ' :
<
<
SPU: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ACOS
FMP FWORK
FST FWORK
LXI RAYON
BSR ASPCT < ACCES AU RAYON.
FMP FWORK
RSR
<
<
< C O M P O S A N T E ' V ' :
<
<
SPV: EQU $
FLD VARV
BSR ACOS
FST FWORK
FLD VARU
BSR ASIN
FMP FWORK
FST FWORK
LXI RAYON
BSR ASPCT
FMP FWORK
RSR
<
<
< C O M P O S A N T E ' W ' :
<
<
SPW: EQU $
FLD VARV
BSR ASIN
FST FWORK
LXI RAYON
BSR ASPCT
FMP FWORK
RSR
:F
:F
< <<'SIOS SPHERE Z'
DF'SIOS TORE HELICE Z'
ED'SIOS TORE HELICE Z'
IN0
PAGE
IDP "SIOS TORE HELICE Z"
<
<
< M I S E S U R U N T O R E H E L I C E
< D ' A X E Z :
<
<
< EQUATION DU TORE :
< X=(R1+R2*COS(V))*COS(U),
< Y=(R1+R2*COS(V))*SIN(U),
< Z=R2*SIN(V)+R3*U.
< OU
< R1 EST LA CONSTANTE 'A 0000',
< R2 EST LA CONSTANTE 'A 0001',
< R3 EST LA CONSTANTE 'A 0002'.
<
<
LOCAL
FLOC: EQU $
R1: FLOAT 0
R2: FLOAT 0
XR1:: VAL 0
XR2:: VAL XR1+1
XR3:: VAL XR2+1
PROG
<
<
< C O O R D O N N E E ' X ' :
<
<
SPU: EQU $
LXI XR1
BSR ASPCT
FST R1
LXI XR2
BSR ASPCT
FST R2
FLD VARV
BSR ACOS
FMP R2
FAD R1
FST FWORK
FLD VARU
BSR ACOS
FMP FWORK
RSR
<
<
< C O O R D O N N E E ' Y ' :
<
<
SPV: EQU $
LXI XR1
BSR ASPCT
FST R1
LXI XR2
BSR ASPCT
FST R2
FLD VARV
BSR ACOS
FMP R2
FAD R1
FST FWORK
FLD VARU
BSR ASIN
FMP FWORK
RSR
<
<
< C O O R D O N N E E ' Z ' :
<
<
SPW: EQU $
LXI XR2
BSR ASPCT
FST R2
FLD VARV
BSR ASIN
FMP R2
FST FWORK
LXI XR3
BSR ASPCT
FMP VARU
FAD FWORK
RSR
:F
:F
< <<'SIOS TORE HELICE Z'
DF'SIOS TORE Z'
ED'SIOS TORE Z'
IN0
PAGE
IDP "SIOS TORE Z"
<
<
< M I S E S U R U N T O R E D ' A X E Z :
<
<
< EQUATION DU TORE :
< X=(R1+R2*COS(V))*COS(U),
< Y=(R1+R2*COS(V))*SIN(U),
< Z=R2*SIN(V).
< OU
< R1 EST LA CONSTANTE 'A 0000',
< R2 EST LA CONSTANTE 'A 0001'.
<
<
LOCAL
FLOC: EQU $
R1: FLOAT 0
R2: FLOAT 0
XR1:: VAL 0
XR2:: VAL XR1+1
PROG
<
<
< C O O R D O N N E E ' X ' :
<
<
SPU: EQU $
LXI XR1
BSR ASPCT
FST R1
LXI XR2
BSR ASPCT
FST R2
FLD VARV
BSR ACOS
FMP R2
FAD R1
FST FWORK
FLD VARU
BSR ACOS
FMP FWORK
RSR
<
<
< C O O R D O N N E E ' Y ' :
<
<
SPV: EQU $
LXI XR1
BSR ASPCT
FST R1
LXI XR2
BSR ASPCT
FST R2
FLD VARV
BSR ACOS
FMP R2
FAD R1
FST FWORK
FLD VARU
BSR ASIN
FMP FWORK
RSR
<
<
< C O O R D O N N E E ' Z ' :
<
<
SPW: EQU $
LXI XR2
BSR ASPCT
FST R2
FLD VARV
BSR ASIN
FMP R2
RSR
:F
:F
< <<'SIOS TORE Z'
DF'SIOS TOUR 1'
ED'SIOS TOUR 1'
IN0
PAGE
IDP "SIOS TOUR 1"
<
<
< T O U R 1 :
<
<
< FONCTION :
< CE MODULE CALCULE LA
< FONCTION SUIVANTE :
<
< X=RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E))*COS(U),
< Y=RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E))*SIN(U),
< Z=F*V.
<
<
< PARAMETRES :
A0:: VAL 0 < COEFFICIENT A,
A1:: VAL A0+1 < B,
A2:: VAL A1+1 < C,
A3:: VAL A2+1 < D,
A4:: VAL A3+1 < E,
A5:: VAL A4+1 < F.
<
<
LOCAL
FLOC: EQU $
ASP1: WORD SP1 < CALCUL DE :
FRAC: FLOAT 0 < RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E)).
XXB: FLOAT 0 < COEFFICIENT B,
XXC: FLOAT 0 < COEFFICIENT C,
XXD: FLOAT 0 < COEFFICIENT D,
XXE: FLOAT 0 < COEFFICIENT E.
PROG
<
<
< C A L C U L D U P O L Y N O M E :
<
<
SP1: EQU $
LXI A4
BSR ASPCT
FST XXE
LXI A3
BSR ASPCT
FST XXD
LXI A2
BSR ASPCT
FST XXC
LXI A1
BSR ASPCT
FST XXB
LXI A0
BSR ASPCT < A,
FMP VARV < A*V,
FAD XXB < A*V+B,
FMP VARV < (A*V+B)*V,
FAD XXC < (A*V+B)*V+C,
FMP VARV < ((A*V+B)*V+C)*V,
FAD XXD < ((A*V+B)*V+C)*V+D,
FMP VARV < (((A*V+B)*V+C)*V+D)*V,
FAD XXE < (((A*V+B)*V+C)*V+D)*V+E,
FABS
BSR ARAC < RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E)).
FST FRAC
RSR
<
<
< C O M P O S A N T E E N ' U ' :
<
<
SPU: EQU $
BSR ASP1 < RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E)),
FLD VARU
BSR ACOS < COS(U),
FMP FRAC < RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E))*COS(
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
BSR ASP1 < RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E)),
FLD VARU
BSR ASIN < SIN(U),
FMP FRAC < RAC(ABS(A*V**4+B*V**3+C*V**2+D*V+E))*SIN(
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
LXI A5
BSR ASPCT
FMP VARV
RSR
:F
:F
< <<'SIOS TOUR 1'
DF'SIOS TOUR 2'
ED'SIOS TOUR 2'
IN0
PAGE
IDP "SIOS TOUR 2"
<
<
< T O U R 2 :
<
<
< FONCTION :
< CE MODULE CALCULE LA
< FONCTION SUIVANTE :
<
< X=(A/(1+(V**2)/C))*COS(U),
< Y=(A/(1+(V**2)/C))*SIN(U),
< Z=B*V.
<
<
< PARAMETRES :
A0:: VAL 0 < COEFFICIENT A,
A1:: VAL A0+1 < B,
A2:: VAL A1+1 < C.
<
<
LOCAL
FLOC: EQU $
ASP1: WORD SP1 < CALCUL DE A/(1+(V**2)/C).
FRAC: FLOAT 0 < A/(1+(V**2)/C).
PROG
<
<
< C A L C U L D U P O L Y N O M E :
<
<
SP1: EQU $
LXI A2
BSR ASPCT
FST FWORK < C,
FLD VARV
FMP VARV
FDV FWORK
FAD F1 < 1+(V**2)/C,
FST FRAC
LXI A0
BSR ASPCT < A,
FDV FRAC < A/(1+(V**2)/C).
FST FRAC
RSR
<
<
< C O M P O S A N T E E N ' U ' :
<
<
SPU: EQU $
BSR ASP1 < (A/(1+(V**2)/C)),
FLD VARU
BSR ACOS < COS(U),
FMP FRAC < (A/(1+(V**2)/C))*COS(U).
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
BSR ASP1 < (A/(1+(V**2)/C)),
FLD VARU
BSR ASIN < SIN(U),
FMP FRAC < (A/(1+(V**2)/C))*SIN(U).
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
LXI A1
BSR ASPCT
FMP VARV
RSR
:F
:F
< <<'SIOS TOUR 2'
DF'SIOS ANNEAU 1'
ED'SIOS ANNEAU 1'
IN0
PAGE
IDP "SIOS ANNEAU 1"
<
<
< M I S E S U R U N A N N E A U 1 :
<
<
< FONCTION :
< CE MODULE MET L'IMAGE RESIDENTE
< SUR LA SURFACE D'EQUATION :
<
< X=(A0*U+A1*V+A2)*COS(A3*U+A4*V+A5)+A6*U+A7*V+A8,
< Y=(A10*U+A11*V+A12)*SIN(A13*U+A14*V+A15)+A16*U+A17*V+A18,
< Z=A20,
<
< QUI PERMET DE FAIRE UN ANNEAU POUR :
< A0=A4=1,
< A10=A14=1,
< TOUT AUTRE A(I)=0,
<
< ET UN RECTANGLE POUR :
< A7=1,
< A16=1,
< TOUT AUTRE A(I)=0,
<
< ET DONC LE DEPLIEMENT D'UN ANNEAU
< POUR LES VALEURS INTERMEDIAIRES.
<
<
< PARAMETRES :
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
A3:: VAL A2+1
A4:: VAL A3+1
A5:: VAL A4+1
A6:: VAL A5+1
A7:: VAL A6+1
A8:: VAL A7+1
A10:: VAL '10
A11:: VAL A10+1
A12:: VAL A11+1
A13:: VAL A12+1
A14:: VAL A13+1
A15:: VAL A14+1
A16:: VAL A15+1
A17:: VAL A16+1
A18:: VAL A17+1
A20:: VAL '20
<
<
LOCAL
FLOC: EQU $
PREM: WORD -1 < INDICATEUR DE PREMIER PASSAGE.
<
< PARAMETRES :
<
FA0: FLOAT 0
FA1: FLOAT 0
FA2: FLOAT 0
FA3: FLOAT 0
FA4: FLOAT 0
FA5: FLOAT 0
FA6: FLOAT 0
FA7: FLOAT 0
FA8: FLOAT 0
FA10: FLOAT 0
FA11: FLOAT 0
FA12: FLOAT 0
FA13: FLOAT 0
FA14: FLOAT 0
FA15: FLOAT 0
FA16: FLOAT 0
FA17: FLOAT 0
FA18: FLOAT 0
FA20: FLOAT 0
PROG
<
<
< C O M P O S A N T E E N ' U ' :
<
<
SPU: EQU $
CPZ PREM < EST-CE LE PREMIER PASSAGE ???
JGE SPU1 < NON...
<
< OUI, ENTREE DES PARAMETRES :
<
IC PREM < ET MEMORISATION...
LXI A0
BSR ASPCT
FST FA0
LXI A1
BSR ASPCT
FST FA1
LXI A2
BSR ASPCT
FST FA2
LXI A3
BSR ASPCT
FST FA3
LXI A4
BSR ASPCT
FST FA4
LXI A5
BSR ASPCT
FST FA5
LXI A6
BSR ASPCT
FST FA6
LXI A7
BSR ASPCT
FST FA7
LXI A8
BSR ASPCT
FST FA8
LXI A10
BSR ASPCT
FST FA10
LXI A11
BSR ASPCT
FST FA11
LXI A12
BSR ASPCT
FST FA12
LXI A13
BSR ASPCT
FST FA13
LXI A14
BSR ASPCT
FST FA14
LXI A15
BSR ASPCT
FST FA15
LXI A16
BSR ASPCT
FST FA16
LXI A17
BSR ASPCT
FST FA17
LXI A18
BSR ASPCT
FST FA18
LXI A20
BSR ASPCT
FST FA20
<
< CALCUL DE 'X' :
<
SPU1: EQU $
FLD FA3 < A3,
FMP VARU < A3*U,
BSR ASFWOR
FLD FA4 < A4,
FMP VARV < A4*V,
BSR APWORK < A3*U+A4*V,
FAD FA5 < A3*U+A4*V+A5,
BSR ACOS < COS(A3*U+A4*V+A5),
PSR A,B
FLD FA0 < A0,
FMP VARU < A0*U,
BSR ASFWOR
FLD FA1 < A1,
FMP VARV < A1*V,
BSR APWORK < A0*U+A1*V,
FLD FA2 < A2,
BSR APWORK < A0*U+A1*V+A2,
PLR A,B
FMP FWORK < (A0*U+A1*V+A2)*COS(A3*U+A4*V+A5),
BSR ASFWOR
FLD FA6 < A6,
FMP VARU < A6*U,
BSR APWORK < ...+A6*U,
FLD FA7 < A7,
FMP VARV < A7*V,
BSR APWORK < ...+A6*U+A7*V,
FAD FA8 < ...+A6*U+A7*V+A8.
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
<
< CALCUL DE 'Y' :
<
FLD FA13 < A13,
FMP VARU < A13*U,
BSR ASFWOR
FLD FA14 < A14,
FMP VARV < A14*V,
BSR APWORK < A13*U+A14*V,
FAD FA15 < A13*U+A14*V+A15,
BSR ASIN < SIN(A13*U+A14*V+A15),
PSR A,B
FLD FA10 < A10,
FMP VARU < A10*U,
BSR ASFWOR
FLD FA11 < A11,
FMP VARV < A11*V,
BSR APWORK < A10*U+A11*V,
FLD FA12 < A12,
BSR APWORK < A10*U+A11*V+A12,
PLR A,B
FMP FWORK < (A10*U+A11*V+A12)*SIN(A13*U+A14*V+A15),
BSR ASFWOR
FLD FA16 < A16,
FMP VARU < A16*U,
BSR APWORK < ...+A16*U,
FLD FA17 < A17,
FMP VARV < A17*V,
BSR APWORK < ...+A16*U+A17*V,
FAD FA18 < ...+A16*U+A17*V+A18.
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
FLD FA20
RSR
:F
:F
< <<'SIOS ANNEAU 1'
DF'SIOS ANNEAU 2'
ED'SIOS ANNEAU 2'
IN0
PAGE
IDP "SIOS ANNEAU 2"
<
<
< D E P L I A G E D ' U N A N N E A U 2 :
<
<
< FONCTION :
< POUR CHAQUE POINT ARGUMENT (X,Y),
< CE MODULE CALCULE :
<
< RHO=SQRT(X**2+Y**2),
< TETA=ARCTG(Y/X),
<
< PUIS RENVOIE LE POINT :
<
< X=A1*RHO*COS(TETAP),
< Y=A2*RHO*SIN(TETAP),
< Z=A3,
<
< AVEC :
< TETAP=A0*TETA SI 'TETA' EST A DROITE
< DE L'AXE DES 'Y',
< TETAP=-A0*TETA DANS L'AUTRE CAS.
<
<
< ARGUMENTS :
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
A3:: VAL A2+2
<
<
LOCAL
FLOC: EQU $
<
< CONSTANTES :
<
XFINF: FLOAT 1000000
PREM: WORD -1 < INDICATEUR DE PREMIER PASSAGE.
<
< ARGUMENTS :
<
FA0: FLOAT 0
FA1: FLOAT 0
FA2: FLOAT 0
FA3: FLOAT 0
<
< VARIABLES :
<
RHO: FLOAT 0
TETA: FLOAT 0
<
< RELAIS :
<
AARCTG: WORD ARCTG < CALCUL DE ARCTG(X)...
AARG: WORD ARG < CALCUL DE (RHO,TETA)...
<
< DONNEES DE CALCUL DE 'ARCTG' :
<
LNF:: VAL 2 < LONGUEUR MOTS D'UN NOMBRE FLOTTANT.
ATGT1: DZS LNF < ZONE DE TRAVAIL 1.
ATGT2: DZS LNF < ZONE DE TRAVAIL 2.
ATGT3: DZS LNF < ZONE DE TRAVAIL 3.
ATGSDX: DZS 1 < INDICATEUR "SIGNE DE X ARGUMENT":
< = 0 : POSITIF OU NUL;
< < 0 : NEGATIF.
ATGPSC: FLOAT 0.0548862
< TG(PI/12).
TPIS2: FLOAT 4.7123889
< 3*PI/2.
ATGPS2: FLOAT 1.5707963
< PI/2.
ATGPS3: FLOAT 1.0471975
< PI/3.
ATGPS6: FLOAT 0.5235988
< PI/6.
ATGUN: FLOAT 1.0
ATGR3: FLOAT 1.7320508
< RACINE DE 3.
ATGP1: FLOAT 0.6031058
ATGP2: FLOAT 0.0516045
ATGP3: FLOAT 0.5591371
ATGP4: FLOAT 1.4087812
<
<
< C A L C U L D E ' A R C T G ' :
<
<
< ARGUMENT :
< (A,B)=TG(TETA).
<
<
< RESULTAT :
< (A,B)=TETA.
<
<
PROG
ARCTG: EQU $
PSR X
STZ ATGSDX < X ARGUMENT POSITIF OU NUL A PRIORI.
FCAZ
JGE ARCTG1
DC ATGSDX < X ARGUMENT NEGATIF.
ARCTG1: EQU $
FABS < U = ABS(X).
FCAM ATGUN
JGE ARCTG2
<
< U < 1 : J RECOIT 0.
<
LXI 0
JMP ARCTG3
ARCTG2: EQU $
<
< U >= 1 : J RECOIT 2 ET U RECOIT 1/U.
<
LXI 2 < J = 2.
FST ATGT1
FLD ATGUN
FDV ATGT1 < U = 1/U.
ARCTG3: EQU $
FCAM ATGPSC < COMPARER U A TG(PI/12).
JG ARCTG4
<
< U <= TG(PI/12) : J RECOIT J+2.
<
ADRI 2,X < J = J + 2.
JMP ARCTG5
ARCTG4: EQU $
<
< U > TG(PI/12) : J RECOIT J+1 ET
< U RECOIT (U * RACINE(3) - 1) / (RACINE(3) + U).
<
ADRI 1,X < J = J + 1.
FST ATGT1
FMP ATGR3
FSB ATGUN
PSR A,B
FLD ATGR3
FAD ATGT1
FST ATGT1
PLR A,B
FDV ATGT1 < U=(U*RACINE(3)-1)/(RACINE(3)+U).
ARCTG5: EQU $
<
< FORMER Y = U * P(U ** 2) LES COEFFICIENTS DU POLYNOME ETANT ATGP1, ATGP2
< ATGP3 ET ATGP4. ON CALCULE :
< Y = U * (P1 - P2 * U ** 2 + (P3 / (P4 + U ** 2)).
<
FST ATGT1 < TRAV1 = U.
FMP ATGT1
FST ATGT3 < TRAV3 = U ** 2.
FAD ATGP4
FST ATGT2
FLD ATGP3
FDV ATGT2
FAD ATGP1
PSR A,B
FLD ATGP2
FMP ATGT3
FST ATGT3
PLR A,B
FSB ATGT3 < Y = P(U ** 2).
FMP ATGT1 < Y = U * P( U ** 2).
FST ATGT1 < TRAV1 = U * P (U ** 2).
<
< BRANCHEMENT SELON VALEUR DE J (REGISTRE 'X').
<
ADRI -2,X
CPZR X
JE ARCTG6
JL ARCTG7
ADRI -1,X
CPZR X
JE ARCTG8
<
< FAIRE Y = PI / 2 - Y.
<
FLD ATGPS2
JMP ARCTG9
ARCTG8: EQU $
<
< FAIRE Y = PI / 3 - Y.
<
FLD ATGPS3
ARCTG9: EQU $
FSB ATGT1 < - Y.
JMP ARCTG6
ARCTG7: EQU $
<
< FAIRE Y = PI / 6 + Y.
<
FAD ATGPS6
ARCTG6: EQU $
<
< AFFECTER A Y LE SIGNE DU X ARGUMENT.
<
CPZ ATGSDX < SIGNE DU X ARGUMENT.
JL ARCTGA
<
< X ARGUMENT POSITIF OU NUL, IL FAUT QUE Y LE SOIT.
<
FCAZ
JGE ARCTGB
FNEG
JMP ARCTGB
ARCTGA: EQU $
<
< X ARGUMENT NEGATIF, IL FAUT QUE Y LE SOIT.
<
FCAZ
JL ARCTGB
FNEG
ARCTGB: EQU $
<
< RESTAURATIONS ET FIN...
<
PLR X
RSR
<
<
< C O M P O S A N T E E N ' U ' :
<
<
SPU: EQU $
CPZ PREM < EST-CE LE PREMIER PASSAGE ???
JGE SPU1 < NON...
<
< CAS DU PREMIER PASSAGE,
< ENTREE DES PARAMETRES :
<
IC PREM < ET MEMORISATION...
LXI A0
BSR ASPCT
FST FA0
LXI A1
BSR ASPCT
FST FA1
LXI A2
BSR ASPCT
FST FA2
LXI A3
BSR ASPCT
FST FA3
<
< CALCUL DE 'X' :
<
SPU1: EQU $
BSR AARG < CALCUL DE (RHO,TETAP)
FLD TETA < TETAP,
BSR ACOS < COS(TETAP),
FMP RHO < RHO*COS(TETAP),
FMP FA1 < A1*RHO*COS(TETAP).
RSR
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
<
< CALCUL DE 'Y' :
<
BSR AARG < CALCUL DE (RHO,TETAP),
FLD TETA < TETAP,
BSR ASIN < SIN(TETAP),
FMP RHO < RHO*SIN(TETAP),
FMP FA2 < A2*RHO*SIN(TETAP).
RSR
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
FLD FA3
RSR
<
<
< C A L C U L D E ( R H O , T E T A ) :
<
<
ARG: EQU $
FLD ATGPS2 < PI/2,
PSR A,B < A PRIORI : 0<= TETA <=3*PI/2...
FLD VARU < U,
FMP VARU < U**2,
BSR ASFWOR
FLD VARV < V,
FMP VARV < V**2,
BSR APWORK < U**2+V**2,
BSR ARAC < SQRT(U**2+V**2),
FST RHO < RHO=SQRT(U**2+V**2).
FLD VARV < V,
FCMZ VARU < 'U' EST-IL NUL ???
JNE ARG2 < NON...
FMP XFINF < OUI, ON PREND L'INFINI DU
< SIGNE DE 'VARV'...
JMP ARG3
ARG2: EQU $
FDV VARU < V/U,
ARG3: EQU $
BSR AARCTG < ARCTG(V/U),
FCMZ VARU < EST-ON A DROITE OU A GAUCHE DE 'X' ???
JGE ARG4 < A DROITE, 'TETA' EST OK...
FAD PI3141 < A GAUCHE, IL FAUT AJOUTER PI...
ARG4: EQU $
FCAZ < QUEL SIGNE ???
JGE ARG5 < OK, POSITIF...
FAD DEUXPI < NEGATIF, ON AJOUTE 2*PI...
ARG5: EQU $
FST TETA < TETA=SQRT(V/U).
FCAM TPIS2 < POSITION PAR RAPPORT A 3*PI/2 ???
PLR A,B < INFERIEUR A PRIORI...
JLE ARG1 < OUI...
FAD DEUXPI < NON, SUPERIEUR...
ARG1: EQU $
BSR ASFWOR < ET SAVE PI/2 OU 2*PI+PI/2...
FSB TETA
FNEG < TETA-PI/2 OU
< TETA-(2*PI+PI/2)...
FMP FA0
FAD FWORK
FST TETA < CE QUI DONNE LE NOUVEAU 'TETAP'...
RSR
:F
:F
< <<'SIOS ANNEAU 2'
DF'SIOS TORSION 1'
ED'SIOS TORSION 1'
IN0
PAGE
IDP "SIOS TORSION 1"
<
<
< T O R S I O N 1 :
<
<
< FONCTION :
< CE MODULE TORD L'IMAGE
< SUIVANT UNE HELICE D'AXE X
< DONT L'EQUATION EST :
<
< X=A5+A0*U,
< Y=A6+A1*V*SIN(A2*U),
< Z=A7+A3*V*COS(A4*U).
<
<
< ARGUMENTS :
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
A3:: VAL A2+1
A4:: VAL A3+1
A5:: VAL A4+1
A6:: VAL A5+1
A7:: VAL A6+1
<
<
LOCAL
FLOC: EQU $
PREM: WORD 0 < INDICATEUR DE PREMIER PASSAGE.
XA0: FLOAT 0
XA1: FLOAT 0
XA2: FLOAT 0
XA3: FLOAT 0
XA4: FLOAT 0
XA5: FLOAT 0
XA6: FLOAT 0
XA7: FLOAT 0
PROG
<
<
< C O M P O S A N T E ' X ' :
<
<
SPU: EQU $
<
< ENTREE DES PARAMETRES AU PREMIER PASSAGE :
<
CPZ PREM < ALORS ???
JG SPU1 < TOURS SUIVANTS...
IC PREM < PREMIER :
LXI A0
BSR ASPCT
FST XA0
LXI A1
BSR ASPCT
FST XA1
LXI A2
BSR ASPCT
FST XA2
LXI A3
BSR ASPCT
FST XA3
LXI A4
BSR ASPCT
FST XA4
LXI A5
BSR ASPCT
FST XA5
LXI A6
BSR ASPCT
FST XA6
LXI A7
BSR ASPCT
FST XA7
SPU1: EQU $
<
< CAS DES TOURS SUIVANTS :
<
FLD VARU < U,
FMP XA0 < A0*U,
FAD XA5 < X=A5+A0*U.
RSR
<
<
< C O M P O S A N T E ' Y ' :
<
<
SPV: EQU $
FLD VARU < U,
FMP XA2 < A2*U,
BSR ASIN < SIN(A2*U),
FMP VARV < V*SIN(A2*U),
FMP XA1 < A1*V*SIN(A2*U),
FAD XA6 < Y=A6+A1*V*SIN(A2*U).
RSR
<
<
< C O M P O S A N T E ' Z ' :
<
<
SPW: EQU $
FLD VARU < U,
FMP XA4 < A4*U,
BSR ACOS < COS(A4*U),
FMP VARV < V*COS(A4*U),
FMP XA3 < A3*V*COS(A4*U),
FAD XA7 < Z=A7+A3*V*COS(A4*U).
RSR
:F
:F
< <<'SIOS TORSION 1'
DF'SIOS VAGUES 1'
ED'SIOS VAGUES 1'
IN0
PAGE
IDP "SIOS VAGUES 1"
<
<
< M I S E S U R D E S S U R F A C E S S I N U S O I D A L E S
< V A G U E S 1 :
<
<
< EQUATION :
< X=AC*U+AD,
< Y=AE*V+AF,
< Z=A0+A1*SIN(A2*U+A3)+
< A4*SIN(A5*V+A6)+
< A7*SIN(A8*U+A9)*SIN(AA*V+AB).
<
<
< PARAMETRES :
A0:: VAL 0
A1:: VAL A0+1
A2:: VAL A1+1
A3:: VAL A2+1
A4:: VAL A3+1
A5:: VAL A4+1
A6:: VAL A5+1
A7:: VAL A6+1
A8:: VAL A7+1
A9:: VAL A8+1
AA:: VAL A9+1
AB:: VAL AA+1
AC:: VAL AB+1
AD:: VAL AC+1
AE:: VAL AD+1
AF:: VAL AE+1
<
<
< L O C A L :
<
<
LOCAL
FLOC: EQU $
<
< VARIABLES :
<
IPREM: WORD 0 < INDICATEUR DE PREMIER PASSAGE...
FWORK3: FLOAT 0 < MANOEUVRE...
<
< COEFFICIENTS :
<
XFA0: FLOAT 0
XFA1: FLOAT 0
XFA2: FLOAT 0
XFA3: FLOAT 0
XFA4: FLOAT 0
XFA5: FLOAT 0
XFA6: FLOAT 0
XFA7: FLOAT 0
XFA8: FLOAT 0
XFA9: FLOAT 0
XFAA: FLOAT 0
XFAB: FLOAT 0
XFAC: FLOAT 0
XFAD: FLOAT 0
XFAE: FLOAT 0
XFAF: FLOAT 0
PROG
<
<
< C O M P O S A N T E E N ' U ' :
<
<
SPU: EQU $
<
< ENTREE DES PARAMETRES :
<
CPZ IPREM < EST-CE DEJA FAIT ???
JG SPU1 < OUI...
IC IPREM < NON, ON LE FAIT :
LXI A0
BSR ASPCT
FST XFA0
LXI A1
BSR ASPCT
FST XFA1
LXI A2
BSR ASPCT
FST XFA2
LXI A3
BSR ASPCT
FST XFA3
LXI A4
BSR ASPCT
FST XFA4
LXI A5
BSR ASPCT
FST XFA5
LXI A6
BSR ASPCT
FST XFA6
LXI A7
BSR ASPCT
FST XFA7
LXI A8
BSR ASPCT
FST XFA8
LXI A9
BSR ASPCT
FST XFA9
LXI AA
BSR ASPCT
FST XFAA
LXI AB
BSR ASPCT
FST XFAB
LXI AC
BSR ASPCT
FST XFAC
LXI AD
BSR ASPCT
FST XFAD
LXI AE
BSR ASPCT
FST XFAE
LXI AF
BSR ASPCT
FST XFAF
SPU1: EQU $
<
< COMPOSANTE 'X' :
<
FLD VARU < U,
FMP XFAC < AC*U,
FAD XFAD < AC*U+AD,
RSR < X=AC*U+AD.
<
<
< C O M P O S A N T E E N ' V ' :
<
<
SPV: EQU $
<
< COMPOSANTE 'Y' :
<
FLD VARV < V,
FMP XFAE < AE*V,
FAD XFAF < AE*V+AF,
RSR < Y=AE*V+AF.
<
<
< C O M P O S A N T E E N ' W ' :
<
<
SPW: EQU $
<
< COMPOSANTE 'Z' :
<
FLD XFA0
BSR ASFWOR < INITIALISATION DU CUMUL AVEC 'A0'...
FCMZ XFA1 < PREMIERE COMPOSANTE ???
JE SPW1 < NON...
FLD VARU < U,
FMP XFA2 < A2*U,
FAD XFA3 < A2*U+A3,
BSR ASIN < SIN(A2*U+A3),
FMP XFA1 < A1*SIN(A2*U+A3),
BSR APWORK < ET CUMULE...
SPW1: EQU $
FCMZ XFA4 < DEUXIEME COMPOSANTE ???
JE SPW2 < NON...
FLD VARV < V,
FMP XFA5 < A5*V,
FAD XFA6 < A5*V+A6,
BSR ASIN < SIN(A5*V+A6),
FMP XFA4 < A4*SIN(A5*V+A6),
BSR APWORK < ET CUMULE...
SPW2: EQU $
FCMZ XFA7 < TROISIEME COMPOSANTE ???
JE SPW3 < NON...
FLD VARU < U,
FMP XFA8 < A8*U,
FAD XFA9 < A8*U+A9,
BSR ASIN < SIN(A8*U+A9),
FST FWORK3 < ET SAVE...
FLD VARV < V,
FMP XFAA < AA*V,
FAD XFAB < AA*V+AB,
BSR ASIN < SIN(AA*V+AB),
FMP FWORK3 < SIN(A8*U+A9)*SIN(AA*V+AB),
FMP XFA7 < A7*SIN(A8*U+A9)*SIN(AA*V+AB),
BSR APWORK < ET CUMULE...
SPW3: EQU $
FLD FWORK
RSR < Z=A0+A1*SIN(A2*U+A3)+
< A4*SIN(A5*V+A6)+
< A7*SIN(A8*U+A9)*SIN(AA*V+A9).
:F
:F
< <<'SIOS VAGUES 1'
DF'SIOS TENTACULES 1'
ED'SIOS TENTACULES 1'
IN0
PAGE
IDP "SIOS TENTACULES 1"
<
<
< M I S E S U R U N E S U R F A C E
< T E N T A C U L A I R E 1 :
<
<
< FONCTION :
< ON SE DEFINIT UNE SURFACE
< EN COORDONNEES SPHERIQUES :
<
< X=R*COS(V)*COS(U),
< Y=R*COS(V)*SIN(U),
< Z=R*SIN(V),
<
< OU 'R' N'EST PAS UNE CONSTANTE
< (COMME POUR LA SPHERE...), MAIS
< UNE FONCTION PRENANT DE TEMPS EN
< TEMPS DES VALEURS INFINIES POUR
< CERTAINES VALEURS DE 'U' ET 'V' :
<
< R=A0+A1/(MAX(ABS(U,A10),ABS(V,A20))*
< MAX(ABS(U,A11),ABS(V,A21))*
< ...
< )
< LE PRODUIT DES 'MAX' ETANT EFFECTUE
< 'A2' FOIS...
<
<
< ARGUMENTS :
A0:: VAL 0 < FACTEUR DE TRANSLATION DE 'R',
A1:: VAL A0+1 < MULTIPLICATEUR DE 'R',
A2:: VAL A1+1 < NOMBRE DE FACTEURS DE TYPE 'MAX' AU
< DENOMINATEUR DE 'R' ; S'IL VAUT '0, ON
< TOMBE SUR UNE SPHERE...
A3:: VAL A2+1 < MAXIMUM DE LA FONCTION 'R',
A10:: VAL '10 < PREMIER ZERO DE L'ENSEMBLE DES (U),
A20:: VAL '20 < PREMIER ZERO DE L'ENSEMBLE DES (V).
< NOTA : POUR 'A10' ET 'A20', UNE VALEUR
< 'FUNDEF' DONNE LA NULLITE DE
< U-U(X) OU V-V(X) QUELQUE SOIT LA
< VALEUR DE 'U' ET 'V'...
NAIJ:: VAL A20-A10 < NOMBRE MAX DE PRODUITS...
<
<
< L O C A L :
<
<
LOCAL
FLOC: EQU $
IPREM: WORD -1 < INDICATEUR DE PREMIER PASSAGE...
FA0: FLOAT 0 < TRANSLATEUR DU RAYON,
FA1: FLOAT 0 < MULTIPLICATEUR DU RAYON.
FUNDEF: FLOAT <'7FFF<0<0 < VALEUR INDETERMINEE D'UN ANGLE...
FRAYON: FLOAT 0 < POUR CALCULER LE RAYON 'R'.
FINFIN: FLOAT 1000000
NA2: WORD 0 < NOMBRE DE FACTEURS DANS LE DENOMINATEUR
< DE 'R'.
ARAYON: WORD RAYON < CALCUL DE LA FONCTION RAYON R(U,V).
PROG
<
<
< C O M P O S A N T E ' X ' :
<
<
SPU: EQU $
<
< TEST DE PREMIER PASSAGE :
<
CPZ IPREM < PREMIER PASSAGE ???
JE SPU1 < NON...
IC IPREM < OUI, ENTREE DE QUELQUES PARAMETRES...
LXI A0
BSR ASPCT
FST FA0 < TRANSLATEUR DE 'R'...
LXI A1
BSR ASPCT
FST FA1 < MULTIPLICATEUR DE 'R'...
LXI A3
BSR ASPCT
FST FINFIN < MAXIMUM DE LA FONCTION 'R'...
SPU2: EQU $
LXI A2
BSR ASPCT
BSR AROND
JAL SPU4 < ERREUR...
CPI NAIJ < VALIDATION...
JLE SPU3 < OK...
SPU4: EQU $
QUIT 1 < E R R E U R ...
SPU3: EQU $
STA NA2 < NOMBRE DE FACTEUR DU DENOMINATEUR...
<
< CALCUL DE LA COMPOSANTE :
<
SPU1: EQU $
BSR ARAYON < R,
FLD VARV < V,
BSR ACOS < COS(V),
FMP FRAYON < R*COS(V),
FST FRAYON
FLD VARU < U,
BSR ACOS < COS(U),
FMP FRAYON < R*COS(V)*COS(U).
<
< ET SORTIE :
<
RSR
<
<
< C O M P O S A N T E ' Y ' :
<
<
SPV: EQU $
BSR ARAYON < R,
FLD VARV < V,
BSR ACOS < COS(V),
FMP FRAYON < R*COS(V),
FST FRAYON
FLD VARU < U,
BSR ASIN < SIN(U),
FMP FRAYON < R*COS(V)*SIN(U).
RSR < ET RETOUR...
<
<
< C O M P O S A N T E ' Z ' :
<
<
SPW: EQU $
BSR ARAYON < R,
FLD VARV < V,
BSR ASIN < SIN(V),
FMP FRAYON < R*SIN(V).
RSR < ET RETOUR...
<
<
< C A L C U L D E R ( U , V ) :
<
<
< RESULTAT :
< FRAYON=R(U,V).
<
<
RAYON: EQU $
PSR X,Y
FLD F0 < AU CAS OU (A2)=0 (SPHERE)...
LX NA2 < (X)=NOMBRE DE FACTEURS A CALCULER.
CPZR X < EST-CE UNE SPHERE ???
JE RAYON6 < OUI, ON RENVOIE 1...
FLD F1
FST FRAYON < INITIALISATION DU CUMUL...
LYI A10 < (Y)=INDEX DU PREMIER ARGUMENT.
RAYON1: EQU $
XR X,Y
FLD F0
FST FWORK1 < INDETERMINE A PRIORI POUR 'U'...
BSR ASPCT < ACCES A U(X),
FCAM FUNDEF < INDETERMINE ???
JE RAYON3 < OUI, (FWORK1)=0 A PRIORI, QUELQUE SOIT
< LA VALEUR DE 'U'...
FSB VARU < U(X)-U,
BSR AFABS < ABS(U(X)-U),
FST FWORK1
RAYON3: EQU $
ADRI A20-A10,X
BSR ASPCT < V(X),
FCAM FUNDEF < INDETERMINE ???
JNE RAYON4 < NON...
FLD F0 < OUI, ON PREND LA VALEUR NULLE
< QUELQUE SOIT 'V'...
JMP RAYON5
RAYON4: EQU $
FSB VARV < V(X)-V,
BSR AFABS < ABS(V(X)-V),
RAYON5: EQU $
FCAM FWORK1 < MAX(ABS(U(X)-U),ABS(V(X)-V))...
JGE RAYON2
FLD FWORK1
RAYON2: EQU $
FMP FRAYON < ET
FST FRAYON < CUMUL...
ADRI A10-A20,X
XR X,Y
ADRI 1,Y < PASSAGE A L'ELEMENT SUIVANT,
JDX RAYON1 < S'IL EXISTE...
FLD FINFIN < INFINI A PRIORI...
FCMZ FRAYON < DENOMINATEUR NUL ???
JE RAYON6 < OUI, ON PREND L'INFINI...
FLD FA1 < NON, A1,
FDV FRAYON < A0/(MAX()*MAX()*...),
FCAM FINFIN < TROP GRAND ???
JLE RAYON7 < NON, OK...
FLD FINFIN < OUI, ON LE TRONQUE...
RAYON7: EQU $
RAYON6: EQU $
FAD FA0 < TRANSLATION,
FST FRAYON < ET RENVOI PAR 'FRAYON'...
PLR X,Y
RSR
:F
:F
< <<'SIOS TENTACULES 1'
Copyright © Jean-François COLONNA, 2022-2024.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2024.