Télécharger relami.eso

Retour à la liste

Numérotation des lignes :

  1. C RELAMI SOURCE BP208322 16/11/18 21:20:55 9177
  2.  
  3. SUBROUTINE RELAMI
  4.  
  5. C=======================================================================
  6. C CE SOUS-PROGRAMME CONSTRUIT LA RIGIDITE LIANT LINEAIREMENT LES DDL
  7. C DES NOEUDS MILIEUX D'UN MAILLAGE QUADRATIQUE AUX NOEUDS SOMMETS
  8. C
  9. C SYNTHAXE GIBIANE : RIG1 = RELA MILI (LMOTS1) GEO1 ;
  10. C=======================================================================
  11.  
  12. C======================== ZONE DE DECLARATIONS =========================
  13.  
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8 (A-H,O-Z)
  16.  
  17. -INC CCOPTIO
  18. -INC CCHAMP
  19. -INC CCGEOME
  20. -INC SMLMOTS
  21. -INC SMCOORD
  22. -INC SMELEME
  23. -INC SMRIGID
  24.  
  25. CHARACTER*4 LESDDL(10),LESDUA(10)
  26.  
  27. SEGMENT IMILI(NBDDL)
  28.  
  29. C========================= CORPS DU PROGRAMME ==========================
  30.  
  31. C==== LECTURE DES ARGUMENTS
  32.  
  33. CALL LIROBJ('LISTMOTS',IP0,0,IRETOU)
  34. IF (IERR.NE.0) RETURN
  35.  
  36. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  37. IF (IERR.NE.0) RETURN
  38.  
  39. C==== NOMS DES INCONNUES DE LA RIGIDITE
  40.  
  41. C Si pas de LISTMOTS, je prends le inconnues de la meca.
  42. IF (IP0.EQ.0) THEN
  43. IF (IFOUR.LT.0) THEN
  44. NBDDL=2
  45. LESDDL(1)='UX '
  46. LESDDL(2)='UY '
  47. LESDUA(1)='FX '
  48. LESDUA(2)='FY '
  49. ELSEIF (IFOUR.EQ.0) THEN
  50. NBDDL=2
  51. LESDDL(1)='UR '
  52. LESDDL(2)='UZ '
  53. LESDUA(1)='FR '
  54. LESDUA(2)='FZ '
  55. ELSEIF (IFOUR.EQ.1) THEN
  56. NBDDL=3
  57. LESDDL(1)='UR '
  58. LESDDL(2)='UT '
  59. LESDDL(3)='UZ '
  60. LESDUA(1)='FR '
  61. LESDUA(2)='FT '
  62. LESDUA(3)='FZ '
  63. ELSE
  64. NBDDL=3
  65. LESDDL(1)='UX '
  66. LESDDL(2)='UY '
  67. LESDDL(3)='UZ '
  68. LESDUA(1)='FX '
  69. LESDUA(2)='FY '
  70. LESDUA(3)='FZ '
  71. ENDIF
  72. ELSE
  73. C Sinon, on prends les DDL specifies et on cherche les duals
  74. MLMOTS=IP0
  75. SEGACT,MLMOTS
  76. NBDDL=MOTS(/2)
  77. DO I=1,NBDDL
  78. DO J=1,LNOMDD
  79. IF (MOTS(I).EQ.NOMDD(J)) THEN
  80. LESDDL(I)=NOMDD(J)
  81. LESDUA(I)=NOMDU(J)
  82. ENDIF
  83. ENDDO
  84. ENDDO
  85. SEGDES,MLMOTS
  86. ENDIF
  87.  
  88. C==== TRANSFORMATION DU MAILLAGE INI. EN SEGMENTS SI BESOIN
  89.  
  90. IF (IDIM.GE.2) THEN
  91. CALL ECROBJ('MAILLAGE',IPT1)
  92. CALL CHANLG
  93. IF (IPT1.EQ.0) THEN
  94. CALL ERREUR(16)
  95. END IF
  96. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  97. IF (IERR.NE.0) RETURN
  98. ENDIF
  99.  
  100. C==== CONSTRUCTION DU MAILLAGE SUPPORT DE LA RIGIDITE
  101.  
  102. C J'initialise un vecteur que je vais remplir de maillages elem.
  103. SEGINI,IMILI
  104.  
  105. IDIMP1=IDIM+1
  106. C Je parcours le maillage ini. et construis les maillages elem.
  107. SEGACT,IPT1
  108. NBSOUS1=IPT1.LISOUS(/1)
  109. C J'ai un maillage simple
  110. IF (NBSOUS1.EQ.0) THEN
  111. IF (IPT1.ITYPEL.EQ.3) THEN
  112. NBEL1=IPT1.NUM(/2)
  113. NBPTI=XCOOR(/1)/IDIMP1
  114. NBPTS=NBPTI+NBDDL*NBEL1
  115. SEGADJ,MCOORD
  116. NBSOUS=0
  117. NBREF=0
  118. NBELEM=NBEL1
  119. NBNN=4
  120. ICPT1=0
  121. DO I=1,NBDDL
  122. SEGINI,IPT2
  123. IPT2.ITYPEL=22
  124. DO J=1,NBEL1
  125. IP=NBPTI+ICPT1+J
  126. IREF=(IP-1)*IDIMP1
  127. IREF2=(IPT1.NUM(2,J)-1)*IDIMP1
  128. DO K=1,IDIMP1
  129. XCOOR(IREF+K)=XCOOR(IREF2+K)
  130. ENDDO
  131. IPT2.NUM(1,J)=IP
  132. IPT2.NUM(2,J)=IPT1.NUM(2,J)
  133. IPT2.NUM(3,J)=IPT1.NUM(1,J)
  134. IPT2.NUM(4,J)=IPT1.NUM(3,J)
  135. ENDDO
  136. SEGDES,IPT2
  137. IMILI(I)=IPT2
  138. ICPT1=ICPT1+NBEL1
  139. ENDDO
  140. ELSE
  141. C Si pas de SEG3, ERREUR
  142. SEGSUP,IMILI
  143. SEGDES,IPT1
  144. CALL ERREUR(16)
  145. RETURN
  146. ENDIF
  147. C J'ai un maillage complexe
  148. ELSE
  149. NBEL1=0
  150. DO ISOUS=1,NBSOUS1
  151. IPT3=IPT1.LISOUS(ISOUS)
  152. SEGACT,IPT3
  153. IF (IPT3.ITYPEL.EQ.3) THEN
  154. NBEL1=NBEL1+IPT3.NUM(/2)
  155. ENDIF
  156. ENDDO
  157. C Si pas de SEG3, ERREUR
  158. IF (NBEL1.EQ.0) THEN
  159. SEGSUP,IMILI
  160. SEGDES,IPT1
  161. CALL ERREUR(16)
  162. RETURN
  163. ENDIF
  164. NBPTI=XCOOR(/1)/IDIMP1
  165. NBPTS=NBPTI+NBDDL*NBEL1
  166. SEGADJ,MCOORD
  167. NBSOUS=0
  168. NBREF=0
  169. NBELEM=NBEL1
  170. NBNN=4
  171. ICPT1=0
  172. DO I=1,NBDDL
  173. ICEL1=0
  174. SEGINI,IPT2
  175. IPT2.ITYPEL=22
  176. DO ISOUS=1,NBSOUS1
  177. IPT3=IPT1.LISOUS(ISOUS)
  178. IF (IPT3.ITYPEL.EQ.3) THEN
  179. NBEL3=IPT3.NUM(/2)
  180. DO J=1,NBEL3
  181. IP=NBPTI+ICPT1+J
  182. IREF=(IP-1)*IDIMP1
  183. IREF2=(IPT3.NUM(2,J)-1)*IDIMP1
  184. DO K=1,IDIMP1
  185. XCOOR(IREF+K)=XCOOR(IREF2+K)
  186. ENDDO
  187. IPT2.NUM(1,ICEL1+J)=IP
  188. IPT2.NUM(2,ICEL1+J)=IPT3.NUM(2,J)
  189. IPT2.NUM(3,ICEL1+J)=IPT3.NUM(1,J)
  190. IPT2.NUM(4,ICEL1+J)=IPT3.NUM(3,J)
  191. ENDDO
  192. ICPT1=ICPT1+NBEL3
  193. ICEL1=ICEL1+NBEL3
  194. ENDIF
  195. SEGDES,IPT3
  196. ENDDO
  197. SEGDES,IPT2
  198. IMILI(I)=IPT2
  199. ENDDO
  200. ENDIF
  201. SEGDES,IPT1
  202.  
  203. C==== CONSTRUCTION DE LA RIGIDITE ASSOCIEE AUX RELA.
  204.  
  205. NRIGEL=NBDDL
  206. NRIGE=8
  207. SEGINI,RI1
  208. RI1.MTYMAT='RIGIDITE'
  209. RI1.IFORIG=IFOUR
  210. NLIGRP=4
  211. NLIGRD=NLIGRP
  212. DO I=1,NRIGEL
  213. C On a un segment DESCR par DDL
  214. SEGINI,DES1
  215. DES1.LISINC(1)='LX'
  216. DES1.LISDUA(1)='FLX'
  217. DES1.NOELEP(1)=1
  218. DES1.NOELED(1)=1
  219. DO J=2,4
  220. DES1.LISINC(J)=LESDDL(I)
  221. DES1.LISDUA(J)=LESDUA(I)
  222. DES1.NOELEP(J)=J
  223. DES1.NOELED(J)=J
  224. ENDDO
  225. SEGDES,DES1
  226. C On a un segment XMATRI par DDL
  227. nelrig=nbel1
  228. SEGINI,XMATR1
  229. XMATR1.RE(1,2,1)=1.
  230. XMATR1.RE(1,3,1)=-0.5
  231. XMATR1.RE(1,4,1)=-0.5
  232. XMATR1.RE(2,1,1)=XMATR1.RE(1,2,1)
  233. XMATR1.RE(3,1,1)=XMATR1.RE(1,3,1)
  234. XMATR1.RE(4,1,1)=XMATR1.RE(1,4,1)
  235. * SEGDES,XMATR1
  236. C On a NBEL1 matrice(s) elementaire(s)
  237. do ioup=2,nelrig
  238. do io=1,xmatr1.re(/2)
  239. do iu=1,xmatr1.re(/1)
  240. xmatr1.re(iu,io,ioup)=xmatr1.re(iu,io,1)
  241. enddo
  242. enddo
  243. enddo
  244. * NELRIG=NBEL1
  245. * SEGINI,IMATR1
  246. * DO J=1,NELRIG
  247. * IMATR1.IMATTT(J)=XMATR1
  248. * ENDDO
  249. SEGDES,xMATR1
  250. C On remplit la rigidite
  251. RI1.COERIG(I)=1.
  252. RI1.IRIGEL(1,I)=IMILI(I)
  253. RI1.IRIGEL(2,I)=0
  254. RI1.IRIGEL(3,I)=DES1
  255. RI1.IRIGEL(4,I)=xMATR1
  256. RI1.IRIGEL(5,I)=NIFOUR
  257. RI1.IRIGEL(6,I)=0
  258. RI1.IRIGEL(7,I)=0
  259. RI1.IRIGEL(8,I)=0
  260. ENDDO
  261. SEGDES,RI1
  262. IPRIG=RI1
  263. SEGSUP IMILI
  264.  
  265. C==== JE SORS LA RIGIDITE
  266.  
  267. CALL ECROBJ('RIGIDITE',IPRIG)
  268.  
  269. RETURN
  270. END
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  

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