Esope source files

   1 : C ROND      SOURCE    CHAT      07/10/30    21:16:55     5942           
   2 : C     1234567890124567890124567898012456789012345678901234567890123456
   3 : 
   4 : C     SOURCE : L. DI VALENTIN    LE 17/06/97
   5 : 
   6 : C     Cette subroutine appele par l'operateur LIGN (grace au mot cle
   7 : C     ROTA) prepare les donnees a transmettre a la subroutine ARC
   8 : C     pour construire un arc de cercle dont on connait le centre
   9 : C     (CENTRE), un point (POINT1) et l'angle d'ouverture en degre a
  10 : C     partir de ce point.
  11 : 
  12 : C     En dimension 3, il est necessaire de fournir la normale au
  13 : C     cercle, ce qui fournit a la fois le plan contenant le cercle
  14 : C     et le sens trigonometrique positif dans ce plan.
  15 : 
  16 : 
  17 :       SUBROUTINE ROND
  18 : 
  19 : 
  20 :       IMPLICIT INTEGER(I-N)
  21 :       IMPLICIT REAL*8 (A-H,O-Z)
  22 : -INC CCREEL
  23 : -INC CCOPTIO
  24 : -INC SMELEME
  25 : -INC SMCOORD
  26 : 
  27 : 
  28 :       INTEGER INBR,IRET,POINT1,POINT2,NORMAL,CENTRE
  29 :       REAL*8  ANGLE,DENS1,DENS2,NORME
  30 :       CHARACTER*(4) TYPE*8
  31 :       CHARACTER*4 MOTCLE(2)
  32 :       logical ltelq
  33 : 
  34 : 
  35 :       DATA MOTCLE/'DINI','DFIN'/
  36 : 
  37 : 
  38 :       INBR = 0
  38 :       CALL LIRENT(INBR,0,IRET)
  39 : 
  40 : 
  41 : *     IF (DENS1*DENS2.LE.0.D0.AND.INBR.LE.0) THEN
  41 : *        CALL ERREUR(17)
  42 : *        RETURN
  43 : *     ENDIF
  44 : 
  45 : 
  46 : C     Lecture du centre.
  47 : 
  47 :       CALL LIROBJ('POINT',CENTRE,1,IRET)
  48 :       IF (IRET.EQ.0) RETURN
  49 : 
  50 : 
  51 : C     Si on a un maillage, on extrait le dernier point
  52 :       IPT1=0
  52 :       CALL LIROBJ('MAILLAGE',IPT1,0,IRET)
  53 :       IF (IRET.EQ.1) THEN
  54 :          SEGACT IPT1
  54 :          CALL EXTRPO(IPT1,1,POINT1)
  55 :       ELSE
  55 :          CALL LIROBJ('POINT',POINT1,1,IRET)
  56 :       ENDIF
  57 :       IF (IERR.NE.0) RETURN
  58 : 
  59 : C     Lecture de l'angle de rotation.
  60 : 
  60 :       CALL LIRREE(ANGLE,1,IRET)
  61 :       IF (IRET.EQ.0) RETURN
  62 : 
  63 :       ANGLE = ANGLE * XPI / 180.D0
  64 : 
  65 : 
  66 : C     En dimension 3, lecture du point fournissant le sens
  67 : C     trigonométrique
  68 : 
  69 :       IF (IDIM.EQ.3) THEN
  69 :          CALL LIROBJ('POINT',NORMAL,1,IRET)
  70 :          IF (IRET.EQ.0) RETURN
  71 :       ENDIF
  72 : 
  73 : 
  74 : C     On recupere les coordonnees du CENTRE
  75 : 
  76 :       XCEN = XCOOR((CENTRE-1)*(IDIM+1) + 1)
  77 :       YCEN = XCOOR((CENTRE-1)*(IDIM+1) + 2)
  78 :       IF (IDIM.EQ.3) THEN
  79 :          ZCEN = XCOOR((CENTRE-1)*(IDIM+1) + 3)
  80 :       ENDIF
  81 :       DENS2=XCOOR((CENTRE)*(IDIM+1))
  82 : 
  83 : C     On recupere les coordonnees du vecteur (CENTRE -> POINT1)
  84 : 
  85 :       X1 = XCOOR((POINT1-1)*(IDIM+1) + 1) - XCEN
  86 :       Y1 = XCOOR((POINT1-1)*(IDIM+1) + 2) - YCEN
  87 : 
  88 :       IF (IDIM.EQ.3) THEN
  89 :          Z1 = XCOOR((POINT1-1)*(IDIM+1) + 3) - ZCEN
  90 :       ELSE
  91 :          Z1 = 0.D0
  92 :       ENDIF
  93 :       DENS1=XCOOR((POINT1)*(IDIM+1))
  94 : 
  95 : C     On cree une place memoire pour le deuxieme point extremite
  96 : 
  97 :       NBPTS  = XCOOR(/1)/(IDIM + 1) + 1
  98 :       POINT2 = NBPTS
  99 :       SEGADJ MCOORD
 100 : 
 101 : 
 102 : C     Calcul des coordonnees de ce point :
 103 : 
 104 : 
 105 : C     Si IDIM = 3 on recupere le vecteur normal.
 106 : 
 107 :       IF (IDIM.EQ.3) THEN
 108 : 
 109 :          Xn = XCOOR((NORMAL-1)*(IDIM+1) + 1)
 110 :          Yn = XCOOR((NORMAL-1)*(IDIM+1) + 2)
 111 :          Zn = XCOOR((NORMAL-1)*(IDIM+1) + 3)
 112 : 
 113 :          NORME = SQRT(Xn*Xn + Yn*Yn + Zn*Zn)
 114 : 
 115 :          Xn = Xn/NORME
 116 :          Yn = Yn/NORME
 117 :          Zn = Zn/NORME
 118 : 
 119 :       ELSE
 120 : 
 121 :          Xn = 0.D0
 122 :          Yn = 0.D0
 123 :          Zn = 1.D0
 124 : 
 125 :       ENDIF
 126 : 
 127 : 
 128 : C     POINT3 = NORMAL vectoriel POINT1 :
 129 : 
 130 :       X3 = Yn*Z1 - Zn*Y1
 131 :       Y3 = Zn*X1 - Xn*Z1
 132 :       Z3 = Xn*Y1 - Yn*X1
 133 : 
 134 : 
 135 : C     Calcul des coordonnees de POINT2 (point extremite)
 136 : 
 137 :       XCOOR((POINT2-1)*(IDIM+1) + 1) = XCEN + COS(ANGLE)*X1
 138 :      &     + SIN(ANGLE)*X3
 139 :       XCOOR((POINT2-1)*(IDIM+1) + 2) = YCEN + COS(ANGLE)*Y1
 140 :      &     + SIN(ANGLE)*Y3
 141 :       IF (IDIM.EQ.3) THEN
 142 :          XCOOR((POINT2-1)*(IDIM+1) + 3) = ZCEN + COS(ANGLE)*Z1
 143 :      &        + SIN(ANGLE)*Z3
 144 :       ENDIF
 145 :       DENS2=SQRT(ABS(DENS1*DENS2))
 146 :          XCOOR(POINT2*(IDIM+1))=DENS2
 147 : 
 148 : 
 148 :  413  CALL LIRMOT(MOTCLE,2,IRET,0)
 149 : 
 150 :       IF (IRET.EQ.1) THEN
 150 :          CALL LIRREE(DENS1,1,IRET)
 151 :          IF (IRET.EQ.0) RETURN
 152 :          GOTO 413
 153 : 
 154 :       ELSEIF (IRET.EQ.2) THEN
 154 :          CALL MESLIR(-169)
 154 :          CALL LIRREE(DENS2,1,IRET)
 155 :          IF (IRET.EQ.0) RETURN
 156 :          GOTO 413
 157 : 
 158 :       ENDIF
 159 : 
 160 : 
 160 :       CALL ARC(POINT1,CENTRE,NORMAL,ANGLE,INBR,DENS1,DENS2,POINT2)
 161 :       IF (IPT1.NE.0) THEN
 161 :         CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
 162 :         SEGACT IPT1,IPT2
 163 :         ltelq=.false.
 163 :         CALL FUSE(IPT1,IPT2,IPT3,ltelq)
 164 :         SEGSUP IPT2
 165 :         SEGDES IPT1,IPT3
 165 :         CALL ECROBJ('MAILLAGE',IPT3)
 166 :       ENDIF
 167 :       RETURN
 168 : 
 169 :       END
 170 : 
 171 : 
 172 : 
 173 : 
 174 : 
 175 : 
 176 : 
 177 :  
 178 :  
 179 :  
 180 :  
 181 :  
 182 :