Télécharger symtri.eso

Retour à la liste

Numérotation des lignes :

symtri
  1. C SYMTRI SOURCE PV 20/04/01 21:16:39 10569
  2.  
  3. C Creation des (matrices de) RIGIDITE associees a des conditions de
  4. C SYMETRIE (operateur SYMT) et d'ANTISYMETRIE (operateur ANTI).
  5.  
  6. C Syntaxe : SYMT ('DEPL')('ROTA') MELEME P1 (P2) (P3) (FLOT1) ;
  7. C ANTI ('DEPL')('ROTA') MELEME P1 (P2) (P3) (FLOT1) ;
  8.  
  9. C 10/2003 : modifications pour integrer cas IDIM=1.
  10. C En dimension 1, ces operateurs ne sont pas disponibles.
  11. C L'utilisation de l'operateur BLOQUE est suffisante !
  12.  
  13. SUBROUTINE SYMTRI(ityp)
  14.  
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8 (A-H,O-Z)
  17.  
  18.  
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCOORD
  23.  
  24. C** DIMENSION XNORM(3)
  25. COMMON / CSYMTR / XNORM(3)
  26.  
  27. DIMENSION U1(3),U2(3)
  28. CHARACTER*4 MOTBLO(2)
  29. DATA MOTBLO / 'DEPL','ROTA' /
  30.  
  31. C Operateurs SYMT et ANTI indisponibles en dimension 1
  32. IF (IDIM.EQ.1) THEN
  33. INTERR(1)=IDIM
  34. CALL ERREUR(709)
  35. RETURN
  36. ENDIF
  37.  
  38. idimp1=IDIM+1
  39. C Signification de ITYP :
  40. C ITYP = 0 si operateur SYMT , ITYP = 1 si operateur ANTI
  41.  
  42. C Lecture de DEPL ou ROTA pour permettre la lecture de la suite
  43. C Signification de IDEPL et IROTA :
  44. C IDEPL=1 (IROTA=1) si mot-cle 'DEPL' ('ROTA') active et =0 sinon
  45. IDEPL=0
  46. IROTA=0
  47. CALL LIRMOT(MOTBLO,2,IMOT,1)
  48. IF (IERR.NE.0) RETURN
  49. 10 IF (IMOT.EQ.1) IDEPL=1
  50. IF (IMOT.EQ.2) IROTA=1
  51. CALL LIRMOT(MOTBLO,2,IMOT,0)
  52. IF (IMOT.NE.0) GOTO 10
  53.  
  54. C Appel a POIEXT pour recuperer le bon ensemble de POINTS
  55. IF (IDIM.EQ.2) THEN
  56. CALL ECRCHA('DROI')
  57. ELSE
  58. CALL ECRCHA('PLAN')
  59. ENDIF
  60. CALL POIEXT
  61. C En 2D et 3D, lecture de l'ensemble des points, ecrit dans la pile
  62. C suite a l'appel a POIEXT, soumis a la condition de (anti)symetrie.
  63. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  64. IF (IERR.NE.0) RETURN
  65. C On construit U1 et U2 perpendiculaires a XNORM (COMMON CSYMTR)
  66. C Attention en DIME 2 : XNORM est le vecteur directeur de la droite
  67. C Ces vecteurs U1 et U2 sont utilises dans le cas IROTA=1.
  68. IF (IDIM.EQ.2) THEN
  69. XTEMP=-XNORM(2)
  70. XNORM(2)=XNORM(1)
  71. XNORM(1)=XTEMP
  72. ENDIF
  73. U1(1)=-XNORM(2)
  74. U1(2)=XNORM(1)
  75. U1(3)=0.D0
  76. SU1=SQRT(U1(1)**2+U1(2)**2)
  77. IF (SU1.GE.0.1) THEN
  78. U1(1)=U1(1)/SU1
  79. U1(2)=U1(2)/SU1
  80. ELSE
  81. U1(1)=0.D0
  82. U1(2)=-XNORM(3)
  83. U1(3)=XNORM(2)
  84. SU1=SQRT(U1(2)**2+U1(3)**2)
  85. U1(2)=U1(2)/SU1
  86. U1(3)=U1(3)/SU1
  87. ENDIF
  88. U2(1)=XNORM(2)*U1(3)-XNORM(3)*U1(2)
  89. U2(2)=XNORM(3)*U1(1)-XNORM(1)*U1(3)
  90. U2(3)=XNORM(1)*U1(2)-XNORM(2)*U1(1)
  91.  
  92. IF (ITYP.EQ.1) GOTO 500
  93. C CONDITION DE SYMETRIE :
  94. C -------------------------
  95. C Cas 'DEPL' : creation du point associe a la "direction"
  96. IF (IDEPL.EQ.1) THEN
  97. segact mcoord*mod
  98. NBPTS=nbpts+1
  99. SEGADJ MCOORD
  100. IPoin=(NBPTS-1)*idimp1
  101. XCOOR(IPoin+1)=XNORM(1)
  102. XCOOR(IPoin+2)=XNORM(2)
  103. IF (IDIM.EQ.3) XCOOR(IPoin+3)=XNORM(3)
  104. XCOOR(IPoin+idimp1)=0.
  105. C Appel a BLOQU 'DEPL' 'DIRE' Poin1
  106. CALL ECROBJ('POINT ',NBPTS)
  107. CALL ECRCHA('DIRE')
  108. CALL ECRCHA('DEPL')
  109. CALL ECROBJ('MAILLAGE',MELEME)
  110. CALL BLOQUE
  111. SEGACT MCOORD*mod
  112. ENDIF
  113. C Cas 'ROTA' : creation des points associes a la "direction"
  114. C En 2D, on fait seulement BLOQUER 'ROTA'
  115. IF (IROTA.EQ.1) THEN
  116. IF (IDIM.EQ.2) THEN
  117. CALL ECRCHA('ROTA')
  118. CALL ECROBJ('MAILLAGE',MELEME)
  119. CALL BLOQUE
  120. SEGACT MCOORD*MOD
  121. ELSE
  122. NBPTA=nbpts
  123. NBPTS=NBPTA+2
  124. SEGADJ MCOORD
  125. XCOOR(NBPTA*idimp1+1)=U1(1)
  126. XCOOR(NBPTA*idimp1+2)=U1(2)
  127. XCOOR(NBPTA*idimp1+3)=U1(3)
  128. XCOOR((NBPTA+1)*idimp1)=0.D0
  129. NBPTA=NBPTA+1
  130. C Appel a BLOQU 'ROTA' 'DIRE' Poin1
  131. CALL ECROBJ('POINT ',NBPTA)
  132. CALL ECRCHA('DIRE')
  133. CALL ECRCHA('ROTA')
  134. CALL ECROBJ('MAILLAGE',MELEME)
  135. CALL BLOQUE
  136. SEGACT MCOORD*MOD
  137. XCOOR(NBPTA*idimp1+1)=U2(1)
  138. XCOOR(NBPTA*idimp1+2)=U2(2)
  139. XCOOR(NBPTA*idimp1+3)=U2(3)
  140. XCOOR((NBPTA+1)*idimp1)=0.D0
  141. NBPTA=NBPTA+1
  142. C Appel a BLOQU 'ROTA' 'DIRE' Poin1
  143. CALL ECROBJ('POINT ',NBPTA)
  144. CALL ECRCHA('DIRE')
  145. CALL ECRCHA('ROTA')
  146. CALL ECROBJ('MAILLAGE',MELEME)
  147. CALL BLOQUE
  148. SEGACT MCOORD*MOD
  149. CALL PRFUSE
  150. ENDIF
  151. ENDIF
  152. IF (IROTA.EQ.1.AND.IDEPL.EQ.1) CALL PRFUSE
  153. RETURN
  154.  
  155. C CONDITION D'ANTISYMETRIE :
  156. C ----------------------------
  157. C Cas 'ROTA' : Creation du point associe a la direction
  158. 500 IF (IROTA.EQ.1) THEN
  159. segact mcoord*mod
  160. NBPTS=nbpts+1
  161. SEGADJ MCOORD
  162. IPoin=(NBPTS-1)*idimp1
  163. XCOOR(IPoin+1)=XNORM(1)
  164. XCOOR(IPoin+2)=XNORM(2)
  165. IF (IDIM.EQ.3) XCOOR(IPoin+3)=XNORM(3)
  166. XCOOR(IPoin+idimp1)=0.
  167. C Appel a BLOQU 'ROTA' 'DIRE'
  168. IF (IDIM.EQ.3) THEN
  169. CALL ECROBJ('POINT ',NBPTS)
  170. CALL ECRCHA('DIRE')
  171. ENDIF
  172. CALL ECRCHA('ROTA')
  173. CALL ECROBJ('MAILLAGE',MELEME)
  174. CALL BLOQUE
  175. SEGACT MCOORD*MOD
  176. ENDIF
  177. C Cas 'DEPL' : creation des points associes a la "direction"
  178. IF (IDEPL.EQ.1) THEN
  179. IF (IDIM.EQ.3) THEN
  180. NBPTA=nbpts
  181. NBPTS=NBPTA+2
  182. SEGADJ MCOORD
  183. XCOOR(NBPTA*idimp1+1)=U1(1)
  184. XCOOR(NBPTA*idimp1+2)=U1(2)
  185. XCOOR(NBPTA*idimp1+3)=U1(3)
  186. XCOOR((NBPTA+1)*idimp1)=0.D0
  187. NBPTA=NBPTA+1
  188. C Appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
  189. CALL ECROBJ('POINT ',NBPTA)
  190. CALL ECRCHA('DIRE')
  191. CALL ECRCHA('DEPL')
  192. CALL ECROBJ('MAILLAGE',MELEME)
  193. CALL BLOQUE
  194. SEGACT MCOORD*MOD
  195. XCOOR(NBPTA*idimp1+1)=U2(1)
  196. XCOOR(NBPTA*idimp1+2)=U2(2)
  197. XCOOR(NBPTA*idimp1+3)=U2(3)
  198. XCOOR((NBPTA+1)*idimp1)=0.
  199. NBPTA=NBPTA+1
  200. C Appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
  201. CALL ECROBJ('POINT ',NBPTA)
  202. CALL ECRCHA('DIRE')
  203. CALL ECRCHA('DEPL')
  204. CALL ECROBJ('MAILLAGE',MELEME)
  205. CALL BLOQUE
  206. SEGACT MCOORD*MOD
  207. CALL PRFUSE
  208. C En 2D, appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
  209. ELSE
  210. SEGACT MCOORD*MOD
  211. NBPTA=nbpts
  212. NBPTS=NBPTA+1
  213. SEGADJ MCOORD
  214. XCOOR(NBPTA*idimp1+1)=U1(1)
  215. XCOOR(NBPTA*idimp1+2)=U1(2)
  216. C** XCOOR(NBPTA*idimp1+3)=U1(3)
  217. XCOOR((NBPTA+1)*idimp1)=0.D0
  218. C** NBPTA=NBPTA+1
  219. CALL ECROBJ('POINT ',NBPTS)
  220. CALL ECRCHA('DIRE')
  221. CALL ECRCHA('DEPL')
  222. CALL ECROBJ('MAILLAGE',MELEME)
  223. CALL BLOQUE
  224. SEGACT MCOORD*MOD
  225. ENDIF
  226. ENDIF
  227. IF (IROTA.EQ.1.AND.IDEPL.EQ.1) CALL PRFUSE
  228. RETURN
  229.  
  230. END
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  

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