Télécharger mutu1.eso

Retour à la liste

Numérotation des lignes :

mutu1
  1. C MUTU1 SOURCE FANDEUR 22/01/03 21:15:32 11237
  2. SUBROUTINE MUTU1(IPMODE,IPCHEL,IPMAIL,IPRIGI)
  3. ************************************************************************
  4. *
  5. * M U T U 1
  6. * ---------
  7. *
  8. *
  9. * FONCTION:
  10. * ---------
  11. * CREATION DE LA MATRICE DE MUTUELLES
  12. * GESTION DES SEGMENTS ET TESTS DE COMPATIBILITE
  13. *
  14. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+)=CONTENU DANS UN COMMUN
  15. * -----------
  16. *
  17. * IPMODE (E) POINTEUR SUR LE SEGMENT MMODEL
  18. * IPCHEL (E) POINTEUR SUR LE SEGMENT MCHELM
  19. * IPMAIL (E) POINTEUR SUR LE SEGMENT MELEME S'il existe
  20. * IPRIGI (S) POINTEUR SUR LE SEGMENT MRIGID
  21. * +IFOMOD (E) VOIR CCOPTIO
  22. *
  23. * MODULES UTILISES:
  24. * -----------------
  25. *
  26. IMPLICIT INTEGER(I-N)
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC SMRIGID
  32. -INC SMCHAML
  33. -INC SMELEME
  34. -INC SMMODEL
  35. -INC SMCOORD
  36. SEGMENT ICPR(nbpts)
  37. SEGMENT ICPR2(nbpts)
  38. *
  39. *
  40. * VARIABLES:
  41. * ----------
  42. *
  43. * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE
  44. * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP
  45. * NBMAIL NOMBRE DE MAILLAGES ELEMENTAIRES
  46. * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE
  47. *
  48. LOGICAL OK
  49. CHARACTER*4 MOTHER,MOCHAL
  50. PARAMETER ( MOTHER='FC ' )
  51. PARAMETER ( MOCHAL='ED ' )
  52. *
  53. * AUTEUR, DATE DE CREATION:
  54. * -------------------------
  55. *
  56. * YANN STEPHAN, LE 28 FEVRIER 1997 (COPIE DE RESI1).
  57. *
  58. * LANGAGE:
  59. * --------
  60. *
  61. * ESOPE + FORTRAN77
  62. *
  63. ************************************************************************
  64. *
  65. *
  66. * VERIFICATION DU LIEU SUPPORT DU CHAMELEM DE CARACTERISTIQUES
  67. *
  68. CALL QUESUP(IPMODE,IPCHEL,2,0,ISUP,IRETCA)
  69. IF(ISUP.GT.1)RETURN
  70. *
  71. * SI LE CHAMELEM EST APPUYE AUX NOEUDS ,ON CHANGE LE SUPPORT
  72. * POUR LES CENTRES DE GRAVITE
  73. *
  74. IF(ISUP.EQ.1)THEN
  75. CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,2)
  76. IF(IRET.NE.0)THEN
  77. CALL ERREUR(IRET)
  78. RETURN
  79. ENDIF
  80. ELSE
  81. IPCHE1=IPCHEL
  82. ENDIF
  83. *
  84. * ACTIVATION DES SEGMENTS MCHELM ET MMODEL
  85. *
  86. MCHELM=IPCHE1
  87. SEGACT,MCHELM
  88. NBMAIC=IMACHE(/1)
  89. *
  90. MMODEL=IPMODE
  91. SEGACT,MMODEL
  92. NBMAIM=KMODEL(/1)
  93. IF (NBMAIM.GT.NBMAIC) THEN
  94. *
  95. * IL MANQUE LES CARACTERISTIQUES D'UNE OU PLUSIEURS PARTIES
  96. * DU MODELE
  97. *
  98. CALL ERREUR(404)
  99. IF(ISUP.EQ.1)SEGSUP MCHELM
  100. RETURN
  101. ENDIF
  102. *
  103. NBMAIL=NBMAIM
  104. *
  105. * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE
  106. *
  107. NRIGE=8
  108. NRIGEL=1
  109. SEGINI,MRIGID
  110. IPRIGI=MRIGID
  111. ICHOLE=0
  112. IMGEO1=0
  113. IMGEO2=0
  114. IFORIG=IFOUR
  115. ISUPEQ=0
  116. MTYMAT='RIGIDITE'
  117. NBGEOR=0
  118. NELRIG=1
  119. * SEGINI,xMATRI
  120. IRIGEL(2,1)=0
  121. IRIGEL(4,1)=0
  122. IRIGEL(5,1)=0
  123. IRIGEL(6,1)=0
  124. IRIGEL(7,1)=2
  125. COERIG(1)=1.D0
  126.  
  127. IFOI=0
  128. *
  129. * creation d'une numerotation locale dans le but de creer un
  130. * element unique support de toute la matrice de mutuelle on prend
  131. * d'abord le maillage issu du modele puis on fait la meme chosepour
  132. * celui issu de IPMAIL
  133. *
  134. SEGINI ICPR,ICPR2
  135. IB=0
  136. DO 41 IMAIL=1,NBMAIL
  137. IMODEL=KMODEL(IMAIL)
  138. SEGACT,IMODEL
  139. MELEME=IMAMOD
  140. SEGACT,MELEME
  141. DO 42 I=1,NUM(/2)
  142. DO 42 J=1,NUM(/1)
  143. IA = NUM(J,I)
  144. IF(ICPR(IA).EQ.0) THEN
  145. IB=IB+1
  146. ICPR(IA)=IB
  147. ENDIF
  148. 42 CONTINUE
  149. 41 CONTINUE
  150. IF( IPMAIL.EQ.0) THEN
  151. *
  152. * on travail sur lui meme
  153. *
  154. * on le cree de tel facon qu'il soit identique en structure a
  155. * celui issu du modele
  156. *
  157. DO 65 KI=1,ICPR(/1)
  158. 65 ICPR2(KI)=ICPR(KI)
  159. NBSOUS = NBMAIL
  160. IF( NBSOUS.EQ.1) THEN
  161. IPMAIL=MELEME
  162. ELSE
  163. NBREF=0
  164. NBNN=0
  165. NBELEM=0
  166. SEGINI IPT5
  167. IPMAIL=IPT5
  168. DO 63 KI=1,NBSOUS
  169. IMODEL=KMODEL(KI)
  170. IPT5.LISOUS(KI)=IMAMOD
  171. 63 CONTINUE
  172. ENDIF
  173. ELSE
  174. *
  175. * on a fournit un deuxieme maillage. il faut verifier qu'il y a
  176. * concordance topologique on boucle sur les zones de ce maillage pour
  177. * construire une numerotation et on verifie qu'eele est compatible
  178. * avec l'autre
  179. *
  180. IPT1=IPMAIL
  181. MELEME=IPT1
  182. SEGACT IPT1
  183. IC=0
  184. IH=MAX(1,IPT1.LISOUS(/1))
  185. IF(IH.NE.KMODEL(/1)) THEN
  186. CALL ERREUR(910)
  187. RETURN
  188. ENDIF
  189. DO 43 K=1,MAX(1,IPT1.LISOUS(/1))
  190. IF(IPT1.LISOUS(/1).NE.0) THEN
  191. MELEME= IPT1.LISOUS(K)
  192. SEGACT MELEME
  193. ENDIF
  194. IMODEL=KMODEL(K)
  195. IPT5=IMAMOD
  196. IF( IPT5.NUM(/2).NE.NUM(/2) )THEN
  197. CALL ERREUR(910)
  198. RETURN
  199. ENDIF
  200. IF( IPT5.NUM(/1).NE.NUM(/1) )THEN
  201. CALL ERREUR(910)
  202. RETURN
  203. ENDIF
  204. DO 44 I=1,NUM(/2)
  205. DO 44 J=1,NUM(/1)
  206. IA = NUM(J,I)
  207. IF(ICPR2(IA).EQ.0) THEN
  208. IC=IC+1
  209. ICPR2(IA)=IC
  210. ENDIF
  211. IH=IPT5.NUM(J,I)
  212. IM = ICPR(IH)
  213. IF(IM.NE.ICPR2(IA)) THEN
  214. CALL ERREUR(910)
  215. RETURN
  216. ENDIF
  217. 44 CONTINUE
  218. 43 CONTINUE
  219. ENDIF
  220. * initialisations du maillages support de la mutuelle
  221. NBNN=IB
  222. NBELEM=1
  223. NBSOUS=0
  224. NBREF=0
  225. SEGINI MELEME
  226. ITYPEL=28
  227. DO 49 K=1,ICPR(/1)
  228. IF( ICPR(K).NE.0) THEN
  229. IA = ICPR(K)
  230. NUM(IA,1) = K
  231. ENDIF
  232. 49 CONTINUE
  233. IPRESU=MELEME
  234. IRIGEL(1,1)=MELEME
  235. *
  236. * initialisation du segment descripteur
  237. *
  238. NLIGRP=IB
  239. NLIGRD=IB
  240. SEGINI DESCR
  241. SEGINI XMATRI
  242. * IMATTT(1)=XMATRI
  243. * SEGDES IMATRI
  244. IRIGEL(3,1)=DESCR
  245. irigel(4,1)=xmatri
  246. xmatri.symre=irigel(7,1)
  247. DO 48 K=1,NLIGRP
  248. LISINC(K)=MOTHER
  249. LISDUA(K)=MOCHAL
  250. NOELEP(K)=K
  251. NOELED(K)=K
  252. 48 CONTINUE
  253. SEGDES DESCR
  254. * Il reste a calculer les matrices (3*3 por les rot3)
  255. * et a les assembler (l'assemblage aura lieu dans rot3M
  256. *
  257. *
  258. * BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL
  259. *
  260. DO 50 IMAIL=1,NBMAIL
  261. *
  262. IFOI=IFOI+1
  263. IMODEL=KMODEL(IMAIL)
  264. SEGACT,IMODEL
  265. ICOQ = 0
  266. NEF=NEFMOD
  267. MELEME=IMAMOD
  268. IPT4=IMAMOD
  269. SEGACT,MELEME
  270. NBNNC=NUM(/1)
  271. NBELEC=NUM(/2)
  272. NBELEM=0
  273. IPT1=IPMAIL
  274. SEGACT,IPT1
  275. NBSOUJ=IPT1.LISOUS(/1)
  276. IF(NBSOUJ.EQ.0) NBSOUJ=1
  277. NBNNJ=0
  278. DO 70 ISOUJ=1,NBSOUJ
  279. IF(NBSOUJ.EQ.1) THEN
  280. IPT2=IPT1
  281. ELSE
  282. IPT2=IPT1.LISOUS(ISOUJ)
  283. SEGACT, IPT2
  284. ENDIF
  285. NBELEJ=IPT2.NUM(/2)
  286. NBELEM=NBELEM+NBELEC*NBELEJ
  287. NBNNJ=MAX(NBNNJ,IPT2.NUM(/1))
  288. 70 CONTINUE
  289. *
  290. * LES 2 MAILLAGES DOIVENT AVOIR LE MEME NOMBRE
  291. * DE MAILLES
  292. * IF(NBELEC.NE.NBELEJ) THEN
  293. * write(6,*) ' cest bien ce message 1'
  294. ** CALL ERREUR(21)
  295. * RETURN
  296. * ENDIF
  297. *
  298. *
  299. CALL MUTU3(NEF,IMAIL,IMODEL,IPCHE1,IPMAIL,XMATRI,ICPR,
  300. $ ICPR2)
  301. IF (IERR.NE.0)GOTO 99
  302. 50 CONTINUE
  303. SEGDES,MRIGID,XMATRI
  304. 99 CONTINUE
  305. SEGSUP ICPR,ICPR2
  306. IF(ISUP.EQ.1)SEGSUP MCHELM
  307. END
  308.  
  309.  
  310.  
  311.  
  312.  

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