Télécharger la plaquette Cast3M


fr en

Télécharger moin.eso

Retour à la liste

Numérotation des lignes : 

moin

  1. C MOIN      SOURCE    JC220346  18/12/04    21:15:47     9991           
  2. C   MODI  ACQUISITION PARAMETRES POUR PROJECTION
  3. C
  4.       SUBROUTINE MOIN(IREP,IP1,IP2,IP3,IP4)
  5.       IMPLICIT INTEGER(I-N)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC TMLNOMS
  10.       SEGMENT LISENT(NTABLE)
  11.       COMMON /CMODI/LIGMAX,XPREC,YPREC
  12.       CHARACTER*8 ZONE,CTYP
  13.       CHARACTER*8 LEGEND(7)
  14.       CALL TRLABL(0.,20.,0.,'Directive MODI - Cas du 3D',26,1.)
  15.       CALL TRLABL(0.,18.,0.,'Vous pouvez reprojeter en sortie de MODI'
  16.      *  ,40,1.)
  17.       CALL TRLABL(0.,16.,0.,'les points deplaces sur une surface',35,1.)
  18.       LEGEND(1)=' '
  19.       LEGEND(2)='Plan'
  20.       LEGEND(3)='Sphere'
  21.       LEGEND(4)='Cylindre'
  22.       LEGEND(5)='Cone'
  23.       LEGEND(6)='Tore'
  24.       LEGEND(7)='Ignorer'
  25.    5  CONTINUE
  26.       CALL MENU(LEGEND,7,8)
  27.       CALL TRAFF(ICLE)
  28.       IF (ICLE.GT.6) THEN
  29.       CALL TRMESS('Erreur ! Recommencez')
  30.         GOTO 5
  31.       ENDIF
  32.       IF (ICLE.EQ.6) THEN
  33.        IREP=0
  34.        RETURN
  35.       ENDIF
  36.       CALL REPERT('POINT   ',NTABLE)
  37.       SEGINI LISENT
  38.       DO 5498 I=1,NTABLE
  39.       CALL LIROBJ('POINT   ',IP1,1,IRETOU)
  40.       IF(IERR.NE.0) RETURN
  41.       LISENT(I)=IP1
  42.  5498 CONTINUE
  43.       CALL REPLIS('POINT   ',MLNOMS)
  44.       SEGACT MLNOMS
  45.       LEGEND(1)=' '
  46.       LEGEND(2)='Cont'
  47.       LEGEND(3)='Terminer'
  48.       CALL MENU(LEGEND,3,8)
  49.       IF (ICLE.EQ.1) THEN
  50.       CALL TRLABL(0.,14.,0.,
  51.      >'Donnez le noms de trois points caracterisant le plan',52,1.)
  52.       CALL TRAFF(ICLE)
  53.       IF (ICLE.EQ.2) THEN
  54.         IREP=0
  55.         RETURN
  56.       ENDIF
  57.   12   CONTINUE
  58.        CALL TRGET('Donnez le nom du premier point :',ZONE)
  59.        DO 10 I=1,LINOMS(/2)
  60.         IF(ZONE.NE.LINOMS(I)) GO TO 10
  61.         IP1=LISENT(I)
  62.         GOTO 11
  63.   10   CONTINUE
  64.       CALL TRMESS('Premier point incorrect')
  65.       CALL TRAFF(ICLE)
  66.       IF (ICLE.EQ.2) THEN
  67.         IREP=0
  68.         RETURN
  69.       ENDIF
  70.       GOTO 12
  71.   11   CONTINUE
  72.        CALL TRGET('Donnez le nom du deuxieme point :',ZONE)
  73.        DO 13 I=1,LINOMS(/2)
  74.         IF(ZONE.NE.LINOMS(I)) GO TO 13
  75.         IP2=LISENT(I)
  76.         GOTO 14
  77.   13   CONTINUE
  78.       CALL TRMESS('Deuxieme point incorrect')
  79.       CALL TRAFF(ICLE)
  80.       IF (ICLE.EQ.2) THEN
  81.         IREP=0
  82.         RETURN
  83.       ENDIF
  84.       GOTO 12
  85.   14   CONTINUE
  86.        CALL TRGET('Donnez le nom du troisieme point :',ZONE)
  87.        DO 15 I=1,LINOMS(/2)
  88.         IF(ZONE.NE.LINOMS(I)) GO TO 15
  89.         IP3=LISENT(I)
  90.         GOTO 16
  91.   15   CONTINUE
  92.       CALL TRMESS('Troisieme point incorrect')
  93.       CALL TRAFF(ICLE)
  94.       IF (ICLE.EQ.2) THEN
  95.         IREP=0
  96.         RETURN
  97.       ENDIF
  98.       GOTO 12
  99.   16   CONTINUE
  100.        IREP=1
  101.        SEGSUP LISENT,MLNOMS
  102.        RETURN
  103.       ENDIF
  104.       IF (ICLE.EQ.2) THEN
  105.       CALL TRLABL(0.,14.,0.,
  106.      >'Donnez les noms du centre et d un point de la sphere',51,1.)
  107.       CALL TRAFF(ICLE)
  108.       IF (ICLE.EQ.2) THEN
  109.         IREP=0
  110.         RETURN
  111.       ENDIF
  112.   22   CONTINUE
  113.        CALL TRGET('Donnez le nom du centre :',ZONE)
  114.        DO 20 I=1,LINOMS(/2)
  115.         IF(ZONE.NE.LINOMS(I)) GO TO 20
  116.         IP1=LISENT(I)
  117.         GOTO 21
  118.   20   CONTINUE
  119.       CALL TRMESS('Centre incorrect')
  120.       CALL TRAFF(ICLE)
  121.       IF (ICLE.EQ.2) THEN
  122.         IREP=0
  123.         RETURN
  124.       ENDIF
  125.       GOTO 22
  126.   21   CONTINUE
  127.        CALL TRGET('Donnez le nom du point :',ZONE)
  128.        DO 23 I=1,LINOMS(/2)
  129.         IF(ZONE.NE.LINOMS(I)) GO TO 23
  130.         IP2=LISENT(I)
  131.         GOTO 24
  132.   23   CONTINUE
  133.       CALL TRMESS('Point incorrect')
  134.       CALL TRAFF(ICLE)
  135.       IF (ICLE.EQ.2) THEN
  136.         IREP=0
  137.         RETURN
  138.       ENDIF
  139.       GOTO 22
  140.   24   CONTINUE
  141.        IREP=2
  142.        SEGSUP LISENT,MLNOMS
  143.        RETURN
  144.       ENDIF
  145.       IF (ICLE.EQ.3) THEN
  146.       CALL TRLABL(0.,14.,0.,'Donnez le noms de deux points de l axe'
  147.      * //'et d un point courant du cylindre',71,1.)
  148.       CALL TRAFF(ICLE)
  149.       IF (ICLE.EQ.2) THEN
  150.         IREP=0
  151.         RETURN
  152.       ENDIF
  153.   32   CONTINUE
  154.        CALL TRGET('Donnez le nom du premier point :',ZONE)
  155.        DO 30 I=1,LINOMS(/2)
  156.         IF(ZONE.NE.LINOMS(I)) GO TO 30
  157.         IP1=LISENT(I)
  158.         GOTO 31
  159.   30   CONTINUE
  160.       CALL TRMESS('Premier point incorrect')
  161.       CALL TRAFF(ICLE)
  162.       IF (ICLE.EQ.2) THEN
  163.         IREP=0
  164.         RETURN
  165.       ENDIF
  166.        GOTO 32
  167.   31   CONTINUE
  168.        CALL TRGET('Donnez le nom du deuxieme point :',ZONE)
  169.        DO 33 I=1,LINOMS(/2)
  170.         IF(ZONE.NE.LINOMS(I)) GO TO 33
  171.         IP2=LISENT(I)
  172.         GOTO 34
  173.   33   CONTINUE
  174.       CALL TRMESS('Second point incorrect')
  175.       CALL TRAFF(ICLE)
  176.       IF (ICLE.EQ.2) THEN
  177.         IREP=0
  178.         RETURN
  179.       ENDIF
  180.        GOTO 32
  181.   34   CONTINUE
  182.        CALL TRGET('Donnez le nom du point courant:',ZONE)
  183.        DO 35 I=1,LINOMS(/2)
  184.         IF(ZONE.NE.LINOMS(I)) GO TO 35
  185.         IP3=LISENT(I)
  186.         GOTO 36
  187.   35   CONTINUE
  188.       CALL TRMESS('Point courant incorrect')
  189.       CALL TRAFF(ICLE)
  190.       IF (ICLE.EQ.2) THEN
  191.         IREP=0
  192.         RETURN
  193.       ENDIF
  194.        GOTO 32
  195.   36   CONTINUE
  196.        IREP=3
  197.        SEGSUP LISENT,MLNOMS
  198.        RETURN
  199.       ENDIF
  200.       IF (ICLE.EQ.4) THEN
  201.       CALL TRLABL(0.,14.,0.,'Donnez les noms du sommet, d un point de'
  202.      *  //' l axe et d un point courant du cone',76,1.)
  203.       CALL TRAFF(ICLE)
  204.       IF (ICLE.EQ.2) THEN
  205.         IREP=0
  206.         RETURN
  207.       ENDIF
  208.   42   CONTINUE
  209.        CALL TRGET('Donnez le nom du centre :',ZONE)
  210.        DO 40 I=1,LINOMS(/2)
  211.         IF(ZONE.NE.LINOMS(I)) GO TO 40
  212.         IP1=LISENT(I)
  213.         GOTO 41
  214.   40   CONTINUE
  215.       CALL TRMESS('Centre incorrect')
  216.       CALL TRAFF(ICLE)
  217.       IF (ICLE.EQ.2) THEN
  218.         IREP=0
  219.         RETURN
  220.       ENDIF
  221.        GOTO 42
  222.   41   CONTINUE
  223.        CALL TRGET('Donnez le nom d un point de l axe :',ZONE)
  224.        DO 43 I=1,LINOMS(/2)
  225.         IF(ZONE.NE.LINOMS(I)) GO TO 43
  226.         IP2=LISENT(I)
  227.         GOTO 44
  228.   43   CONTINUE
  229.       CALL TRMESS('Point de l axe incorrect')
  230.       CALL TRAFF(ICLE)
  231.       IF (ICLE.EQ.2) THEN
  232.         IREP=0
  233.         RETURN
  234.       ENDIF
  235.        GOTO 42
  236.   44   CONTINUE
  237.        CALL TRGET('Donnez le nom d un point courant :',ZONE)
  238.        DO 45 I=1,LINOMS(/2)
  239.         IF(ZONE.NE.LINOMS(I)) GO TO 45
  240.         IP3=LISENT(I)
  241.         GOTO 46
  242.   45   CONTINUE
  243.       CALL TRMESS('Point courant incorrect')
  244.       CALL TRAFF(ICLE)
  245.       IF (ICLE.EQ.2) THEN
  246.         IREP=0
  247.         RETURN
  248.       ENDIF
  249.        GOTO 42
  250.   46   CONTINUE
  251.        IREP=4
  252.        SEGSUP LISENT,MLNOMS
  253.        RETURN
  254.       ENDIF
  255.       IF (ICLE.EQ.5) THEN
  256.       CALL TRLABL(0.,14.,0.,
  257.      > 'Donnez les noms du centre du tore, d un point de son axe',56,1.)
  258.       CALL TRLABL(0.,12.,0.,
  259.      >', d un centre de petit cercle et d un point courant',51,1.)
  260.       CALL TRAFF(ICLE)
  261.       IF (ICLE.EQ.2) THEN
  262.         IREP=0
  263.         RETURN
  264.       ENDIF
  265.   52   CONTINUE
  266.        CALL TRGET('Donnez le nom du centre du tore :',ZONE)
  267.        DO 50 I=1,LINOMS(/2)
  268.         IF(ZONE.NE.LINOMS(I)) GO TO 50
  269.         IP1=LISENT(I)
  270.         GOTO 51
  271.   50   CONTINUE
  272.       CALL TRMESS('Centre incorrect')
  273.       CALL TRAFF(ICLE)
  274.       IF (ICLE.EQ.2) THEN
  275.         IREP=0
  276.         RETURN
  277.       ENDIF
  278.        GOTO 52
  279.   51   CONTINUE
  280.        CALL TRGET('Donnez le nom d un point de l axe :',ZONE)
  281.        DO 53 I=1,LINOMS(/2)
  282.         IF(ZONE.NE.LINOMS(I)) GO TO 53
  283.         IP2=LISENT(I)
  284.         GOTO 54
  285.   53   CONTINUE
  286.       CALL TRMESS('Point de l axe incorrect')
  287.       CALL TRAFF(ICLE)
  288.       IF (ICLE.EQ.2) THEN
  289.         IREP=0
  290.         RETURN
  291.       ENDIF
  292.        GOTO 52
  293.   54   CONTINUE
  294.        CALL TRGET('Donnez le nom d un centre de petit '
  295.      *  //'cercle :',ZONE)
  296.       DO 55 I=1,LINOMS(/2)
  297.         IF(ZONE.NE.LINOMS(I)) GO TO 55
  298.         IP3=LISENT(I)
  299.         GOTO 56
  300.   55   CONTINUE
  301.       CALL TRMESS('Petit cercle incorrect')
  302.       CALL TRAFF(ICLE)
  303.       IF (ICLE.EQ.2) THEN
  304.         IREP=0
  305.         RETURN
  306.       ENDIF
  307.        GOTO 52
  308.   56  CONTINUE
  309.        CALL TRGET('Donnez le nom d un point courant :',ZONE)
  310.        DO 57 I=1,LINOMS(/2)
  311.         IF(ZONE.NE.LINOMS(I)) GO TO 57
  312.         IP4=LISENT(I)
  313.         GOTO 58
  314.   57   CONTINUE
  315.       CALL TRMESS('Point courant incorrect')
  316.       CALL TRAFF(ICLE)
  317.       IF (ICLE.EQ.2) THEN
  318.         IREP=0
  319.         RETURN
  320.       ENDIF
  321.        GOTO 52
  322.   58   CONTINUE
  323.        IREP=5
  324.        SEGSUP LISENT,MLNOMS
  325.        RETURN
  326.       ENDIF
  327.       END
  328.  
  329.  
  330.  
  331.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales