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-2022.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2022.