EOT         #SIX ESPACE#
XEBUG:   VAL         5               < LONGUEUR DE 'DEBUG'...
XRROR:   VAL         5               < LONGUEUR DE 'ERROR'...
         PAGE
<
<
<        T R A C E   D ' U N   C E R C L E  :
<
<
<        ARGUMENTS :
<                    'A'=ADRESSE D'UNE TABLE D'ARGUMENTS CONTENANT
<                        LE RAYON 'RHO' ET LES COORDONNEES DU CENTRE
<                        (X,Y,Z), LE TOUT EN FLOTTANT.
<
<
<
X:       VAL         0
Y:       VAL         1
Z:       VAL         2
XX:      VAL         X*2
YY:      VAL         Y*2
ZZ:      VAL         Z*2
ZZZX0:   VAL         XX              < X(CENTRE)
ZZZY0:   VAL         YY              < Y(CENTRE)
ZZZZ0:   VAL         ZZ              < Z(CENTRE)
ZZZRHO:  VAL         DIMM            < RAYON.
<                      CE SOUS-PROGRAMME CALCULE L'EQUATION DU
<                    CERCLE EN COORDONNEES POLAIRES, LA CONVERTIT
<                    ENSUITE EN CARTESIENNES, PUIS EN FAIT LE
<                    TRACE...
<
<
FTEST::  VAL         'F700           < FONCTION DE TEST D'UN SYMBOLE.
CART    @
         IF          4=FTEST,XWOR%,,XWOR%
         EOT         #SI CART#
XWOR%:   VAL         0
SQRT    @
         IF          4=FTEST,XWOR%,,XWOR%
         EOT         #SI SQRT#
XWOR%:   VAL         0
DEBUG   @
         IF          XEBUG=FTEST,,XWOR%,
         EOT         #SI TG#
XWOR%:   VAL         0
ERROR   @
         IF          XRROR=FTEST,,XWOR%9,
         PAGE
<
<
<        C A L C U L   D ' U N   S I N U S   E T   D ' U N   C O S I N U S  :
<
<
<        ARGUMENT :
<                    A=ADRESSE D'UNE TABLE DE 4 MOTS CONTENANT
<                      L'ANGLE TETA, PUIS A LA SUITE LE RESUL-
<                      TAT CIN(TETA).
<
<
         DSEC
ARGCIN:  EQU         $
YYTETA:  DZS         2               < ANGLE TETA ARGUMENT,
YYCINU:  DZS         2               < RESULTAT CIN(TETA).
         LOCAL
CINLOC:  EQU         $
YY2322:  FLOAT       506
YY2120:  FLOAT       420
YY1918:  FLOAT       342
YY1716:  FLOAT       272
YY1514:  FLOAT       210
YY1312:  FLOAT       156
YY1110:  FLOAT       110
YY0908:  FLOAT       72
YY0706:  FLOAT       42
YY0504:  FLOAT       20
YY0302:  FLOAT       6
YYPI:    FLOAT       3.1415926
YY2PI:   FLOAT       6.2831853
YYPI2:   FLOAT       1.5707963
YY3PI2:  FLOAT       4.7123889
YYTETB:  DZS         2               < TETA ARGUMENT TRANSLATE...
YYTETC:  DZS         2               < TETA ARGUMENT TRANSLATE AU CARRE.
YY0001:  FLOAT       1
YYACIN:  WORD        CIN             < PROGRAMME DE CALCUL DU CINUS.
         PROG
         USE         W,ARGCIN
<
<
<        C A L C U L   D U   S I N U S  :
<
<
CIN:     EQU         $
         PSR         A,B,L,W
         LRM         L
         WORD        CINLOC+'80      < BASE L,
         LR          A,W             < BASE W SUR L'ARGUMENT.
<
< TRANSLATION DE TETA :
<
         FLD         YYTETA
         FDV         YY2PI           < TETA/(2*PI).
         FIX
         FLT
         FSB         YYTETA
         FNEG                        < TETA MODULO 2*PI.
         FCAM        YYPI2
         JLE         CIN1            < 0<=TETB<=(PI/2).
         FSB         YYPI            < TETB <-- TETB-PI.
         FCAM        YYPI2
         JLE         CIN2            < (PI/2)<TETB<=(3*PI/2).
         FSB         YYPI            < TETB <-- TETB-PI.
         FNEG
CIN2:    EQU         $
         FNEG
CIN1:    EQU         $
         FST         YYTETB          < ET VOILA LE TETA TRANSLATE...
         FMP         YYTETB
         FST         YYTETC          < TETC=TETB*TETB.
<
< CALCUL DE LA SERIE :
<
         FNEG
         FDV         YY1514
         FAD         YY0001
         FMP         YYTETC
         FDV         YY1312
         FSB         YY0001
         FMP         YYTETC
         FDV         YY1110
         FAD         YY0001
         FMP         YYTETC
         FDV         YY0908
         FSB         YY0001
         FMP         YYTETC
         FDV         YY0706
         FAD         YY0001
         FMP         YYTETC
         FDV         YY0504
         FSB         YY0001
         FMP         YYTETC
         FDV         YY0302
         FAD         YY0001
         FMP         YYTETB
         FST         YYCINU          < ET VOILA LE TRAVAIL...
         FABS
         FCAM        YY0001          < VALIDATION DU RESULTAT...
         JLE         CIN3            < OK, INFERIEUR A 1...
         WORD        '1E16           < ????
CIN3:    EQU         $
         PLR         A,B,L,W
         RSR
<
<
<        C A L C U L   D U   C O S I N U S  :
<
<
COS:     EQU         $
         PSR         A,B,L,W
         LRM         L
         WORD        CINLOC+'80      < BASE L,
         LR          A,W             < W BASE LES ARGUMENTS.
         FLD         YYTETA
         PSR         A,B             < SAUVEGARDE DU TETA ARGUMENT.
         FLD         YYPI2
         FSB         YYTETA          < (PI/2)-TETA.
         FST         YYTETA          < NOUVEL ARGUMENT :
         LR          W,A             < A=ADRESSE ARGUMENT.
         BSR         YYACIN          < CALCUL DE CIN((PI/2)-TETA)=COS(TETA).
         PLR         A,B
         FST         YYTETA          < RESTAURATION DU TETA...
         PLR         A,B,L,W
         RSR
         PAGE
<
<
<        P A S S A G E   P O L A I R E - C A R T E S I E N  :
<
<
<        ARGUMENT :
<                    A=ADRESSE D'UNE TABLE DEFINI EN DSEC.
<
<
XWOR%9:  VAL         0
         DSEC
ARGCAR:  EQU         $
YYRHO:   DZS         2               < RAYON POLAIRE,
YYTET:   DZS         2               < TETA EN RADIANS,
YYFLX:   DZS         2               < RESULTAT X,
YYFLY:   DZS         2               < RESULTAT Y.
         PROG
ERROR   @
         IF          XRROR=FTEST,,XWOR%9,
         LOCAL
CARLOC:  EQU         $
YYARG:   DZS         4               < ARGUMENT POUR LE CINUS...
YYBCIN:  WORD        CIN             < SOUS-PROGRAMME DU CINUS,
YYBCOS:  WORD        COS             < SOUS-PROGRAMME DU COCINUS.
         PROG
         USE         W,ARGCAR
KART:    EQU         $
         PSR         A,B,L,W
         LRM         L
         WORD        CARLOC+'80      < BASE L,
         LR          A,W             < W BASE LES ARGUMENTS.
         FLD         YYTET
XWOR%:   VAL         YYTETA-ARGCIN
         FST         YYARG+XWOR%     < TRANSMISSION DE TETA.
         LAD         YYARG           < A=ADRESSE ARGUMENT.
         BSR         YYBCIN          < CALCUL DU CINUS,
XWOR%:   VAL         YYCINU-ARGCIN
         FLD         YYARG+XWOR%     < RECUPERATION DU CINUS...
         FMP         YYRHO
         FST         YYFLY           < Y=RHO*CIN(TETA).
         LAD         YYARG           < A=ADRESSE ARGUMENT.
         BSR         YYBCOS          < CALCUL DU COCINUS,
XWOR%:   VAL         YYCINU-ARGCIN
         FLD         YYARG+XWOR%     < RECUPERATION DU COCINUS...
         FMP         YYRHO
         FST         YYFLX           < X=RHO*COS(TETA).
         PLR         A,B,L,W
         RSR
XWOR%9:  VAL         0
SIN     @
         IF          3=FTEST,XWOR%,,XWOR%
         EOT         #SI SIN#
XWOR%:   VAL         0
XWORK:   VAL         SIN-ZERO
XASIN:   EQU         ZERO+XWORK
COS     @
         IF          3=FTEST,XWOR%,,XWOR%
         EOT         #SI COS#
XWOR%:   VAL         0
XWORK:   VAL         COS-ZERO
XACOS:   EQU         ZERO+XWORK
<
<        TABLE DE STOCKAGE D'UN SOUS-ENSEMBLE DES COORDONNEES
<        DES POINTS D'UN CERCLE.
<
NC:      VAL         12
NC:      VAL         NC*2+1          < NOMBRE MAXIMUM DE CERCLES (IMPAIR).
XPAS:    VAL         2               < ON PRENDRA UN PAS SUR 2 SUR CHAQUE
                                     < CERCLE POUR GENERER LES MERIDIENS.
XNPS:    VAL         15              < NOMBRE DE MERIDIENS.
NP::     VAL         XPAS*XNPS       < NOMBRE MAXIMUM DE POINTS PAR CERCLE.
BETA::   VAL         30              < PARAMETRE D'ECHANTILLONNAGE DES POINTS.
ZZTAB:   EQU         $
         NLS
         DO          NC*NP
         DZS         6
         LST
ZZTABF:  EQU         $
<
<
<        L O C A L   :
<
<
DEBUG   @
         IF          XEBUG=FTEST,,XWOR%9,
         TABLE
LMX:     VAL         1>6
MX:      DZS         LMX
XWOR%9:  VAL         0
         LOCAL
ZZZ300:  EQU         $
ZZLTAB:  WORD        ZZTABF-ZZTAB    < LONGUEUR-MOTS DE 'ZZTAB'.
ZZZ301:  DZS         2*DIMM          < TABLE DE GENERATION DES CHAINES DE
                                     < DEPLACEMENT GRAPHIQUE.
ZZZ302:  DZS         8               < LISTE DES ARUMENTS A 'CART'...
ZZSAVZ:  DZS         2               < SAUVEGARDE DE Z PAR 'CERCLE'.
ERROR   @
         IF          XRROR=FTEST,,XWOR%9,
YZZ302:  DZS         8               < LISTE DES ARGUMENTS A 'KART'...
XWOR%9:  VAL         0
ZZZ311:  VAL         0               < RHO EN FLOTTANT,
ZZZ312:  VAL         2               < TETA EN FLOTTANT,
ZZZ313:  VAL         4               < X EN FLOTTANT,
ZZZ314:  VAL         6               < Y EN FLOTTANT.
ZZZ303:  EQU         FZERO           < ZERO FLOTTANT.
ZZZ304:  FLOAT       0
                                     < NOMBRE DE PAS SUR UN CERCLE.
IZZ304:  WORD        NP              < NOMBRE DE POINTS SUR UN CERCLE.
ZZZ306:  FLOAT       0
                                     < PAS D'INCREMENTATION DE TETA.
ZZZ305:  WORD        '6403;'87EE     < 2*PI
ACART:   WORD        CART            < SOUS-PROGRAMME DE CONVERSION...
ERROR   @
         IF          XRROR=FTEST,,XWOR%9,
AKART:   WORD        KART            < PASSAGE POLAIRE --> CARTESIEN.
DEUX:    FLOAT       2
XWOR%9:  VAL         0
ASQRT:   WORD        SQRT            < SOUS-PROGRAMME RACINE CARRE.
ZZZ320:  ASCI        "A$"            < DEBUT DE CHAINE DE SEGMENT,
ZZZ321:  ASCI        "B$"            < FIN DE CHAINE DE SEGMENTS.
ZZZ322:  ASCI        "OR$"
<
ZZBETA:  WORD        BETA            < PARAMETRE D'ECHANTILLONNAGE.
ZZNCER:  WORD        0               < NUMERO DU CERCLE COURANT.
ZZNC:    WORD        NC              < NOMBRE MAXIMUM DE CERCLES.
ZZPAS:   WORD        XPAS            < PAS D'ECHANTILLONNAGE.
ZZ6:     WORD        6               < SIX...
ZZAXT:   WORD        ZZTAB-1,X       < RELAI INDEXE SUR 'ZZTAB'.
AZZCP:   WORD        ZZCP            < CALCUL DU PAS D'ECHANTILLONNAGE ET
                                     < RAZ DE 'ZZTAB'.
AZZSTK:  WORD        ZZSTK           < STOCKAGE DES COORDONNEES D'UN POINT
                                     < DANS 'ZZTAB'.
ACERCL:  WORD        CERCLE          < S/P DE TRACE D'UN CERCLE.
<
< DONNEES CONCERNANT LA GENERATION D'UNE FAMILLE DE CERCLES.
<
COEFA:   VAL         2               < COEFFICIENT A DE L'HYPERBOLE.
COEFB:   VAL         1               < COEFFICIENT B DE L'HYPERBOLE.
COEFC:   VAL         40              < COEFFICIENT C DE L'HYPERBOLE.
DELTAZ:  VAL         16              < PAS DE VARIATION DE Z0.
<
ZZVIZ0:  WORD        -NC/2*DELTAZ    < VALEUR INITIALE DE Z0.
ZZVCZ0:  DZS         2               < VALEUR COURANTE DE Z0 EN FIXE.
ZZA2:    DZS         2               < COEFFICIENT A AU CARRE, FLOTTANT.
ZZC2:    DZS         2               < COEFFICIENT C AU CARRE, FLOTTANT.
ZZB:     DZS         2               < COEFFICIENT B, FLOTTANT.
ZZZ02:   DZS         2               < Z0 COURANT AU CARRE, FLOTTANT.
ZZTFL:   DZS         5               < ZONE DE TRAVAIL, ECHANGE DE PARAMETRES
                                     < AVEC LE S/P 'SQRT'.
<
ZZZ401:  DZS         DIMM+2          < DESCRIPTEUR DE CERCLE POUR LE S/P
                                     < 'CERCLE'
ZZZ402:  ASCI        "TE2$"
<
< ANGLE DE ROTATION POUR CALCUL DE LA MATRICE DE TRANSFORMATION.
<
TETROT:  FLOAT       0.0
DEBUG   @
         IF          XEBUG=FTEST,,XWOR%9,
ZZZ500:  DZS         4               < POUR 'TG'.
ATG:     WORD        TG              < CALCUL D'UNE TANGENTE...
ZZZ360:  FLOAT       360
AMX:     WORD        MX,X
DEM:     WORD        '0202
         WORD        MX-ZERO*2;0
RC:      WORD        '6D00
DRC:     WORD        '0202;RC-ZERO*2;1
DIX:     FLOAT       1000
INDIC:   WORD        0
XWOR%9:  VAL         0
<
<
<
<        P R O G R A M M E  :
<
<
         PROG
CERCLE:  EQU         $
         PSR         A,B,X,Y
         PSR         C,L,W
         LRM         L
         WORD        ZZZ300+'80      < INITIALISATION DE LA BASE L.
         LR          A,W             < W=ADRESSE DES ARGUMENTS...
<
< CALCUL (EVENTUEL, C'EST-A-DIRE SEULEMENT AU PREMIER APPEL DE
< CE S/P CERCLE), DU PAS D'ECHANTILLONNAGE DES POINTS DES CERCLES
< EN VUE DE LEUR STOCKAGE DANS 'ZZTAB'.
<
         LA          ZZNCER          < PREMIER CERCLE ? (!)
         JANE        ZZCER1
         BSR         AZZCP           < C'EST LE PREMIER CERCLE, ALLONS
                                     < CALCULER LE PAS D'ECHANTILLONNAGE
                                     < ET RAZER 'ZZTAB'.
ZZCER1:  EQU         $
<
< CALCUL DU PAS D'INCREMENTATION DE TETA :
<
         LA          IZZ304
         FLT
         FST         ZZZ304
         FLD         ZZZ305          < 2*PI.
         FDV         ZZZ304          < 2*PI/NOMBRE DE PAS.
         FST         ZZZ306
<
< SAUVONS Z QUI DOIT RESTER CONSTANT.
<
         FLD         ZZZZ0,W
         FST         ZZSAVZ
<
< CALCUL DU PREMIER POINT :
<
         FLD         ZZZ303          < ZERO FLOTTANT.
         FST         ZZZ301+XX       < ORIGINE...
         FST         ZZZ301+YY
         FST         ZZZ301+ZZ
         LAD         ZZZ322
         BSR         AINTA           < MISE A L'ORIGINE...
         FLD         ZZZX0,W
         FAD         ZZZRHO,W
         FST         ZZZ301+DIMM+XX  < X=X0+RHO.
         FLD         ZZZY0,W
         FST         ZZZ301+DIMM+YY  < Y=Y0.
         FLD         ZZSAVZ          < Z EST CONSTANT.
         FST         ZZZ301+DIMM+ZZ
         LAD         ZZZ301+DIMM
         LR          W,B             < SAVE W.
         LRM         W
         WORD        ZZMAT           < ADRESSE MATRICE.
         BSR         AZZTRS          < TRANSFORMATION MATRICIELLE.
         BSR         AMCVA           < INTERPRETEUR ('A' EST BON!)
         LR          B,W             < RECUP W.
         PSR         X
         LAD         ZZZ301
         LR          A,B
         LAD         ZZZ301+DIMM
         LXI         DIMM
         MOVE                        < CHANGEMENT D'ORIGINE...
         PLR         X
         LAD         ZZZ320
         BSR         AINTA           < DEBUT DE CHAINE DE SEGMENTS.
<
< INITIALISATIONS :
<
         FLD         ZZZ303          < ZERO...
         FST         ZZZ302+ZZZ312   < INITIALISATION DE TETA.
         FLD         ZZZRHO,W
         FST         ZZZ302+ZZZ311   < INITIALISATION DE RHO.
ERROR   @
         IF          XRROR=FTEST,,XWOR%9,
         FST         YZZ302+ZZZ311
XWOR%9:  VAL         0
<
< BOUCLE DE PARCOURS DU CERCLE :
<
         LX          IZZ304          < X=NOMBRE DE POINTS.
ZZZ330:  EQU         $
         FLD         ZZZ302+ZZZ312
         FAD         ZZZ306
         FST         ZZZ302+ZZZ312   < PROGRESSION DE TETA.
ERROR   @
         IF          XRROR=FTEST,,XWOR%9,
         FST         YZZ302+ZZZ312
         LAD         YZZ302
         BSR         AKART
XWOR%9:  VAL         0
         FLD         ZZZ302+ZZZ312   < ACCES A TETA :
         FSB         ZZZ305          < TETA-2*PI,
         FABS                        < ABS(TETA-2*PI),
         FDV         FAROND
         FCAM        ZZZ306          < NUL A EPSILON PRES ???
         JGE         ZZZ370          < NON...
         FLD         ZZZ303          < OUI, ON PREND 0 A FIN QUE
         FST         ZZZ302+ZZZ312   < LE CERCLE SE REFERME...
ZZZ370:  EQU         $
         LAD         ZZZ302          < A=ADRESSE DE LA LISTE ARGUMENTS.
         BSR         ACART           < CONVERSION POLAIRE --> CARTESIENNE.
ERROR   @
         IF          XRROR=FTEST,,XWOR%9,
         FLD         ZZZ302+ZZZ313
         FAD         YZZ302+ZZZ313
         FDV         DEUX
         FST         ZZZ302+ZZZ313   < MOYENNE DES X.
         FLD         ZZZ302+ZZZ314
         FAD         YZZ302+ZZZ314
         FDV         DEUX
         FST         ZZZ302+ZZZ314   < MOYENNE DES Y.
XWOR%9:  VAL         0
DEBUG   @
         IF          XEBUG=FTEST,,XWOR%9,
<
< VERIFICATION THEOREME :
<
         FLD         ZZZ302+ZZZ313
         FMP         ZZZ302+ZZZ313
         FST         FLW1
         FLD         ZZZ302+ZZZ314
         FMP         ZZZ302+ZZZ314
         FAD         FLW1
         FST         FLW1
         LA          ZZZRHO,W
         MP          ZZZRHO,W
         LR          B,A
         FLT
         FSB         FLW1
         FCAZ
         JE          ZZZ337
ZZZ337:  EQU         $
         FMP         DIX
         FIX
         JAE         ZZZ338
         CPZ         INDIC
         JNE         ZZZ338          < AUTRES FOIS...
         JMP         ZZ4307
RZZ330:  JMP         ZZZ330
ZZ4307:  EQU         $
         PSR         A,B,X
         LBI         ">"
         LR          A,X
         JAG         ZZ4301
         LBI         "<"
         NGR         X,X
ZZ4301:  EQU         $
         STX         DEM+2
         LRM         A
         WORD        LMX-1
         ANDR        A,X
         LR          B,A
         PSR         X,Y
         LYI         0
ZZ4303:  EQU         $
         XR          X,Y
         STBY        &AMX
         XR          X,Y
         ADRI        1,Y
         JDX         ZZ4303
         PLR         X,Y
         LAD         CG
         SVC         0
         LAD         DEM
ZZ4302:  EQU         $
         PSR         X
         SVC         0
         PLR         X
         JDX         ZZ4302
         LAD         OG
         SVC         0
         PLR         A,B,X
ZZZ338:  EQU         $
XWOR%9:  VAL         0
DEBUG   @
         IF          XEBUG=FTEST,,XWOR%9,
<
< VALIDATIONS DES TANGENTES :
<
         LA          ZZZ301+DIM+X
         FLT
         FST         FLW1
         LA          ZZZ301+DIM+Y
         FLT
         FDV         FLW1
         FST         FLW1            < Y/X.
                                     < C'EST AUSSI TG(TETA) DESSINE.
         FLD         ZZZ302+ZZZ312   < TETA PRESUME.
         FST         ZZZ500+0
         LAD         ZZZ500
         BSR         ATG
         FLD         ZZZ500+2        < TG(TETA) PRESUME.
         FSB         FLW1            < ERREUR SUR LES TANGENTES...
         FIX
         JAE         ZZZ339          < OK...
         CPZ         INDIC
         JNE         ZZZ339          < AUTRES FOIS...
         PSR         A
         FLD         ZZZ302+ZZZ312
         FMP         ZZZ360          < *360,
         FDV         ZZZ305          < CONVERSION EN DEGRES.
         FIX
         LR          A,B
         PLR         A
         PSR         A,B,X
         LBI         "+"
         LR          A,X
         JAG         ZZ3301
         LBI         "-"
         NGR         X,X
ZZ3301:  EQU         $
         STX         DEM+2
         LRM         A
         WORD        LMX-1
         ANDR        A,X
         LR          B,A
         PSR         X,Y
         LYI         0
ZZ3303:  EQU         $
         XR          X,Y
         STBY        &AMX
         XR          X,Y
         ADRI        1,Y
         JDX         ZZ3303
         PLR         X,Y
         LAD         CG
         SVC         0
         LAD         DEM
ZZ3302:  EQU         $
         PSR         X
         SVC         0
         PLR         X
         JDX         ZZ3302
         LAD         OG
         SVC         0
         PLR         A,B,X
ZZZ339:  EQU         $
XWOR%9:  VAL         0
XTRAV:   VAL         YYFLX-ARGCAR
YTRAV:   VAL         YYFLY-ARGCAR
         FLD         ZZZ302+XTRAV    < X CALCULE PAR 'CART'
         FST         ZZZ301+DIMM+XX
         FLD         ZZZ302+YTRAV    < Y CALCULE PAR 'CART'
         FST         ZZZ301+DIMM+YY
         FLD         ZZSAVZ          < Z.
         FST         ZZZ301+DIMM+ZZ
         LAD         ZZZ301+DIMM
         LR          W,B             < SAVE W.
         LRM         W
         WORD        ZZMAT           < ADRESSE MATRICE.
         BSR         AZZTRS          < TRANSFORMATION DES COORDONNEES.
         BSR         AMCVA           < INTERPRETEUR ('A' EST BON!).
         LR          B,W             < RECUP W.
         BSR         AZZSTK          < STOCKAGE (EVENTUEL) DES COORDONNEES
                                     < DU POINT COURANT DANS 'ZZTAB'.
         LAD         ZZZ321
         BSR         AINTA           < FIN DE CHAINE DE SEGMENTS...
         PSR         X
         LAD         ZZZ301
         LR          A,B             < B=ADRESSE DE L'ORIGINE,
         LAD         ZZZ301+DIMM     < A=ADRESSE DE L'EXTREMITE,
         LXI         DIMM            < X=LONGUEUR.
         MOVE                        < CHAINAGE DES SEGMENTS...
         PLR         X
DEBUG   @
         IF          XEBUG=FTEST,XWOR%,,XWOR%
         JDX         ZZZ330          < AU POINT SUIVANT...
XWOR%:   VAL         0
         IF          XEBUG=FTEST,,XWOR%,
         JDX         RZZ330          < AU POINT SUIVANT...
XWOR%:   VAL         0
         IC          ZZNCER          < PROGRESSION NUMERO DE CERCLE.
         PLR         C,L,W
         PLR         A,B,X,Y
         RSR
ZZCP:    EQU         $
<
<        C A L C U L   D U   P A S   D ' E C H A N T I L L O N N A G E
<
<        E T   R A Z   D E   ' Z Z T A B '.
<
         PSR         A,B,X
<
< RAZ DE 'ZZTAB.
<
         LX          ZZLTAB          < LONGUEUR MOT DE 'ZZTAB'.
ZZCP3:   EQU         $
         STZ         &ZZAXT
         JDX         ZZCP3
<
         PLR         A,B,X
         RSR
ZZSTK:   EQU         $
<
<        S T O C K A G E   ( E V E N T U E L )   D E S   C O O R D O N N E E S
<
<        ( X , Y , Z )   D U   P O I N T   C O U R A N T   D U   C E R C L E
<
<        C O U R A N T.
<
<        ARGUMENTS:
<                    'X'=NUMERO DU POINT COURANT (DE N A 1).
<                    'ZZNCER'=NUMERO DU CERCLE COURANT (DE 0 A NC-1)
<
<        LES COORDONNEES NE SONT STOCKEES QUE SI LE NUMERO DU POINT
<        COURANT EST DIVISIBLE PAR 'ZZPAS'.
<
         PSR         A,B,X
         LB          IZZ304
         SBR         X,B             < B=NUMERO DU POINT (DE 0 A N-1).
         LAI         0
         DV          ZZPAS
         CPZR        B
         JNE         ZZSTK1          < PAS DE STOCKAGE.
<
< ICI ON A :         'A'=NUMERO DU POINT ECHANTILLONNE (DE 0 A IZZ304/ZZPAS-1)
<                    'ZZNCER'=NUMERO CERCLE COURANT (DE 0 A 'NC'-1).
<
< CALCUL DE L'ADRESSE DE STOCKAGE =6*('A'*NC+'ZZNCER'), ET STOCKAGE.
<
         MP          ZZNC
         LR          B,A
         AD          ZZNCER
         MP          ZZ6
         LRM         A
         WORD        ZZTAB
         ADR         A,B             < RECEPTEUR.
         LAD         ZZZ301+DIMM     < EMETTEUR.
         LXI         DIMM            < 6 MOTS (X,Y,Z).
         MOVE
ZZSTK1:  EQU         $
         PLR         A,B,X
         RSR
         PAGE
<
<
<        P R O G R A M M E   D E   T R A C E  :
<
<
         PROG
GRAPH:   EQU         $
         USE         L,ZZZ300+'80
         LRM         C,L,K
         WORD        COM+'80
         WORD        ZZZ300+'80
         WORD        PILE-1
<
< CALCUL D'UNE MATRICE DE TRANSFORMATION A APPLIQUER AU COORDONNEES
<        (X,Y,Z) DES POINTS QUE L'ON CALCULERA.
<
         FLD         TETROT          < TETA ROTATION
         LYI         XX/2            < OU YY/2, OU ZZ/2 :
                                     < AXE DE ROTATION.
         BSR         AZZCMT          < CALCUL DE LA MATRICE.
<
<
< TRACE D'UNE FAMILLE DE CERCLES DE RAYON 'RHO' LE CENTRE EN ETANT
< (X0,Y0,Z0) AVEC:
< X0=Y0=0
< Z0= Z0 COURANT.
<
<          LE CALCUL DU Z0 COURANT ET DU RAYON RHO EST FAIT DE LA
<        FACON SUIVANTE:
<        - ON PART DE L'EQUATION D'UNE HYPERBOLE:
<          ( X**2 / B**2 ) - ( Z**2 / A**2 ) = C**2
<        - Z VARIE DE (-NC/2*DELTAZ) A (+NC/2*DELTAZ) PAR PAS DE DELTAZ
<        - RHO = B * ( C**2 + ( Z**2 / A**2 ) ) ** (1 / 2 )
<        - A, B, C ET DELTAZ SONT DES PARAMETRES RESPECTIVEMENT :
<          'COEFA', 'COEFB', 'COEFC', 'DELTAZ'.
<
<
<        INITIALISATIONS.
<
         LAD         ZZZ402
         BSR         AINTA
<
         FLD         ZZZ303          < ZERO FLOTTANT.
         FST         ZZZ401+XX       < X0 INITIAL.
         FST         ZZZ401+YY       < Y0 INITIAL.
         LA          ZZVIZ0          < VALEUR INITIALE Z0.
         STA         ZZVCZ0          < VALEUR COURANTE Z0.
<
         LAI         COEFA
         FLT
         FST         ZZA2
         FMP         ZZA2
         FST         ZZA2            < COEFFICIENT A AU CARRE, FLOTTANT.
<
         LAI         COEFC
         FLT
         FST         ZZC2
         FMP         ZZC2
         FST         ZZC2            < CEFFICIENT C AU CARRE, FLOTTANT.
<
         LAI         COEFB
         FLT
         FST         ZZB             < COEFFICIENT B, FLOTTANT.
<
         LXI         NC              < NOMBRE DE CERCLES A GENERER.
TOUR3:   EQU         $
<
<         BOUCLE DE GENERATION DES CERCLES.
<
         PSR         X
<
<        CALCUL DE RHO = B * ( C**2 + ( Z**2 / A**2 ) ) ** (1/2)
<
         LA          ZZVCZ0          < Z0 COURANT ENTIER.
         FLT
         FST         ZZZ401+ZZ       < POUR 'CERCLE'.
         FST         ZZZ02
         FMP         ZZZ02
         FST         ZZZ02           < Z0 AU CARRE, FLOTTANT.
         FDV         ZZA2            < SUR COEF A AU CARRE.
         FAD         ZZC2            < + COEF C AU CARRE.
         FST         ZZTFL           < POUR LE S/P 'SQRT'.
         LAD         ZZTFL           < POUR 'SQRT'.
         BSR         ASQRT           < RACINE CARREE.
         LA          ZZTFL+4         < CODE RETOUR.
         JAE         TOUR4           < OK.
         WORD        '1E16           < ERREUR SQRT.
TOUR4:   EQU         $
         FLD         ZZTFL+2         < RACINE CARREE.
         FMP         ZZB             < * COEFB.
         FST         ZZZ401+ZZZRHO   < RAYON DU CERCLE.
<
         LAD         ZZZ401          < POUR 'CERCLE'
         BSR         ACERCL          < GENERATION DU CERCLE.
<
         LA          ZZVCZ0          < Z0 COURANT ENTIER.
         ADRI        DELTAZ,A
         STA         ZZVCZ0          < NOUVEAU Z0.
<
         PLR         X
DEBUG   @
         IF          XEBUG=FTEST,,XWOR%9,
XWOR%9:  VAL         0
         JDX         TOUR3           < AU SUIVANT.
<
< TRACE DES SEGMENTS RELIANT LES CERCLES, A PARTIR DE LA TABLE
< 'ZZTAB' CONTENANT LES COORDONNEES DE POINTS ECHANTILLONNES.
<
         LB          IZZ304
         LAI         0
         DV          ZZPAS           < NOMBRE DE POINTS ECHANTILLONNES
                                     < PAR CERCLE
         LR          A,X
         LR          A,Y
TOUR1:   EQU         $
<
<        AUTANT DE FOIS QU'IL Y A DE POINTS "ECHANTILLONNES" PAR CERCLE
<
         PSR         X
         LR          Y,A
         SBR         X,A
         MP          ZZNC
         LR          B,A
         MP          ZZ6
         LRM         W
         WORD        ZZTAB
         ADR         B,W             < 'W' BASE LA BONNE "LIGNE" DE 'ZZTAB'.
         LAD         ZZZ322
         BSR         AINTA           < MISE A L'ORIGINE.
<
         FLD         XX,W
         FST         ZZZ301+DIMM+XX
         FLD         YY,W
         FST         ZZZ301+DIMM+YY
         FLD         ZZ,W
         FST         ZZZ301+DIMM+ZZ
         LAD         ZZZ301+DIMM
         BSR         AMCVA           < INTERPRETEUR.
         LAD         ZZZ320          < PRIMITIVE A.
         BSR         AINTA
<
         LXI         NC-1
<
<        AUTANT DE FOIS QU'IL Y A DE CERCLES ... -1, FAIRE 'B'.
<
TOUR2:   EQU         $
         PSR         X
         ADRI        DIMM,W          < COORDONNEES DU POINT SUIVANT.
         LAD         0,W
         BSR         AMCVA           < INTERPRETEUR.
         LAD         ZZZ321          < PRIMITIVE 'B'.
         BSR         AINTA           < INTERPRETATION.
<
         PLR         X
         JDX         TOUR2           < AU POINT SUIVANT.
<
         PLR         X
         JDX         TOUR1           < A LA SERIE DE POINTS SUIVANTE.
<
         WORD        '1E16
         JMP         $-1
         END



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.