Télécharger dyne02.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE02 SOURCE PV 16/11/17 21:59:07 9180
  2. SUBROUTINE DYNE02(ICHOLX,IRSCPR,NDDL,IRIG,IVEC,IPZ,IPM,
  3. & MBLO,MBLO2,IPRIGZ,ICPC)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. ************************************************************************
  7. *
  8. * D Y N E 0 2
  9. * -----------
  10. *
  11. * FONCTION:
  12. * ---------
  13. * UTILITAIRE DE L'OPERATEUR "DYNE"
  14. * -1 T
  15. * CALCUL DU PRODUIT : Z = A M A
  16. *
  17. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  18. * -----------
  19. *
  20. * ICHOLX (E) POINTEUR SUR LE SEGMENT MMATRI ( ACTIF )
  21. * IRSCPR (E) POINTEUR SUR LE SEGMENT ICPR ( ACTIF )
  22. * NDDL (E) NOMBRE DE DEGRES DE LIBERTE
  23. * IRIG (E) POINTEUR SUR L'OBJET RIGIDITE A ( ACTIF )
  24. * IVEC (E/S) POINTEUR SUR UN VECTEUR DE TRAVAIL
  25. * IPZ (S) POINTEUR SUR LE SEGMENT MZZZ ( LAISSE ACTIF )
  26. * -1
  27. * IPM (S) POINTEUR SUR LE VECTEUR CONTENANT M ( LAISSE ACTIF
  28. * MBLO (S) POINTEUR SUR LE SEGMENT MBLO | VOIR PLUS BAS
  29. * MBLO2 (S) POINTEUR SUR LE SEGMENT MBLO2 | ( LAISSES ACTIFS )
  30. * IPRIGZ (S) POINTEUR SUR L'OBJET RIGIDITE Z
  31. * ICPC (S) POINTEUR SUR UN SEGMENT DE TYPE ICPR ( LAISSE ACTIF )
  32. *
  33. * REMARQUES:
  34. * ----------
  35. * CETTE VERSION NE TRAITE QUE LES DDL BLOQUES, POUR LES RELATIONS
  36. * IL FAUDRA PROCEDER AUTREMENT EN CE QUI CONCERNE LA MATRICE A.
  37. * -1 T
  38. * LE PRODUIT A M A NE SERA PLUS UNE MATRICE DIAGONALE, ON DEVRA
  39. * EFFECTUER UNE RESOLUTION : C'EST POURQUOI ON CREE L'OBJET Z
  40. * DE TYPE RIGIDITE.
  41. *
  42. * AUTEUR, DATE DE CREATION:
  43. * -------------------------
  44. * DENIS ROBERT, LE 16 NOVEMBRE 1988.
  45. *
  46. * LANGAGE:
  47. * --------
  48. * ESOPE + FORTRAN77
  49. *
  50. ************************************************************************
  51. *
  52. * MODULES UTILISES:
  53. *
  54. -INC CCOPTIO
  55. -INC SMELEME
  56. -INC SMRIGID
  57. -INC SMMATRI
  58. -INC SMVECTD
  59. -INC SMCOORD
  60. *
  61. PARAMETER ( UN = 1.D0 )
  62. PARAMETER ( ZERO = 0.D0 )
  63. *
  64. CHARACTER*4 NI
  65. *
  66. *--- SEGMENTS DE TRAVAIL :
  67. * -1 T
  68. * MZZZ CONTIENT LE PRODUIT A M A RANGE EN LIGNE
  69. * -1
  70. * MBLO CONTIENT LE PRODUIT A M TABLEAU IDDL * NDDL
  71. * MBLO2 CONTIENT LA MATRICE A TABLEAU IDDL * NDDL
  72. * ICP. CONTIENT DES REFERENCES GEOMETRIQUES
  73. * MUITRA CONTIENT LES CORRESPONDANCES DES COMPOSANTES
  74. *
  75. SEGMENT MUITRA(NLIGRA)
  76. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  77. SEGMENT ICPA(XCOOR(/1)/(IDIM+1))
  78. SEGMENT ICPB(XCOOR(/1)/(IDIM+1))
  79. SEGMENT ICPC(XCOOR(/1)/(IDIM+1))
  80. SEGMENT,MZZZ
  81. REAL*8 ZZZZ(LONZ,LONZ)
  82. ENDSEGMENT
  83. SEGMENT,MBLO
  84. REAL*8 BLO(IDDL,NDDL)
  85. ENDSEGMENT
  86. POINTEUR MBLO2.MBLO
  87. *
  88. MVECTD=IVEC
  89. MMATRI=ICHOLX
  90. MINCPO=IINCPO
  91. MIMIK=IIMIK
  92. ICPR=IRSCPR
  93. SEGINI,ICPA,ICPB,ICPC
  94. LNA=ICPA(/1)
  95. ININC=IMIK(/2)
  96. *
  97. DO 5 ILNA=1,LNA
  98. ICPA(ILNA)=0
  99. ICPB(ILNA)=0
  100. ICPC(ILNA)=0
  101. 5 CONTINUE
  102. * END DO
  103. *
  104. IF (IRIG.NE.0) THEN
  105. *
  106. *--- L'OBJET RIGIDITE "A" EXISTE
  107. *
  108. *------------------------------------------------*
  109. *--- BOUCLE SUR LES ZONES ELEMENTAIRES DE A ---*
  110. *------------------------------------------------*
  111. *
  112. IK=0
  113. IKK=0
  114. RI1=IRIG
  115. SEGACT,RI1
  116. NRIGE1=RI1.IRIGEL(/2)
  117. DO 20 IRI=1,NRIGE1
  118. MELEME=RI1.IRIGEL(1,IRI)
  119. SEGACT,MELEME
  120. *
  121. *--- REMPLISSAGE DE ICPA ET ICPB
  122. * REMARQUE : N1= 3 CAR ON VEUT TOUJOURS LE 3EME NOEUD QUI
  123. * EST RELATIF AU DDL PHYSIQUE
  124. *
  125. N1=NUM(/1)
  126. N2=NUM(/2)
  127. DO 30 I2 = 1,N2
  128. IKK=IKK+1
  129. K=NUM(3,I2)
  130. ICPC(IKK)=NUM(1,I2)
  131. IF (ICPA(K).EQ.0) THEN
  132. IK=IK+1
  133. ICPA(K)=IK
  134. ICPB(IK)=K
  135. ENDIF
  136. 30 CONTINUE
  137. * END DO
  138. SEGDES,MELEME
  139. 20 CONTINUE
  140. * END DO
  141. IDDL=IKK
  142. *
  143. *---------------------------------------*
  144. *--- CREATION DE LA GEOMETRIE DE Z ---*
  145. *---------------------------------------*
  146. *
  147. NBSOUS=0
  148. NBREF=0
  149. NBNN=1
  150. NBELEM=IK
  151. SEGINI,IPT1
  152. DO 10 II=1,IK
  153. IPT1.NUM(1,II)=ICPB(II)
  154. 10 CONTINUE
  155. * END DO
  156. IPOGEO=IPT1
  157. SEGDES,IPT1
  158. SEGINI,MBLO
  159. DO 31 IA1=1,IDDL
  160. DO 32 IA2=1,NDDL
  161. BLO(IA1,IA2)=ZERO
  162. 32 CONTINUE
  163. * END DO
  164. 31 CONTINUE
  165. * END DO
  166. *
  167. *---------------------------------------------------*
  168. *--- RE-BOUCLE SUR LES ZONES ELEMENTAIRES DE A ---*
  169. *---------------------------------------------------*
  170. *
  171. IPPL=0
  172. NLIGRP=IDDL
  173. NLIGRD=IDDL
  174. SEGINI,DESCR
  175. DO 50 IR=1,NRIGE1
  176. MELEME=RI1.IRIGEL(1,IR)
  177. SEGACT,MELEME
  178. DES1=RI1.IRIGEL(3,IR)
  179. SEGACT,DES1
  180. *
  181. *--- ON REMPLIT MUITRA(IN) = IJ QUI DIT QUE LA IEME INCONNUE
  182. *--- DE LA ZONE ELEMENTAIRE DE "A" EST LA JEME DE ININC
  183. *
  184. NLIGRA=DES1.LISINC(/2)
  185. SEGINI,MUITRA
  186. DO 51 IN=1,NLIGRA
  187. NI=DES1.LISINC(IN)
  188. DO 52 IJ=1,ININC
  189. IF(NI.EQ.IMIK(IJ)) GO TO 53
  190. 52 CONTINUE
  191. * END DO
  192. 53 CONTINUE
  193. MUITRA(IN)=IJ
  194. 51 CONTINUE
  195. * END DO
  196. * xMATR1=RI1.IRIGEL(4,IR)
  197. COER=RI1.COERIG(IR)
  198. * SEGACT,xMATR1
  199. NN2=NUM(/2)
  200. *
  201. *---------------------------------------*
  202. *--- REMPLISSAGE DU TABLEAU BLO ---*
  203. *---------------------------------------*
  204. *
  205. DO 60 I22=1,NN2
  206. IPPL=IPPL+1
  207. * XMATR1=IMATR1.IMATTT(I22)
  208. * SEGACT,XMATR1
  209. *
  210. J2=ICPR(NUM(DES1.NOELEP(3),I22))
  211. J1=MUITRA(3)
  212. IKI=INCPO(J1,J2)
  213. BLO(IPPL,IKI)=UN
  214. *
  215. NOELEP(IPPL)=ICPA(NUM(DES1.NOELEP(3),I22))
  216. NOELED(IPPL)=ICPA(NUM(DES1.NOELED(3),I22))
  217. LISINC(IPPL)=DES1.LISINC(3)
  218. LISDUA(IPPL)=DES1.LISDUA(3)
  219. *
  220. * SEGDES,XMATR1
  221. 60 CONTINUE
  222. * END DO
  223. SEGDES,DES1,MELEME
  224. SEGSUP,MUITRA
  225. 50 CONTINUE
  226. * END DO
  227. IPDES1=DESCR
  228. SEGDES,DESCR,RI1
  229. *
  230. IF (IPPL.NE.IDDL) THEN
  231. WRITE(IOIMP,*)'DYNE : IL MANQUE ',(IDDL-IPPL),' BLOCAGES |'
  232. ENDIF
  233. *
  234. *------------------------------------------*
  235. * -1 T *
  236. *--- CALCUL DU PRODUIT : Z = A M A *
  237. *------------------------------------------*
  238. *
  239. SEGINI,MBLO2=MBLO
  240. * -1
  241. *--- CALCUL DE : A M ---> RANGE DANS BLO
  242. *
  243. DO 100 IL=1,IDDL
  244. DO 200 IK=1,NDDL
  245. IF (BLO(IL,IK).NE.ZERO) THEN
  246. BLO(IL,IK)=VECTBB(IK)
  247. ENDIF
  248. 200 CONTINUE
  249. * END DO
  250. 100 CONTINUE
  251. * END DO
  252. * -1 T
  253. *--- CALCUL DE : A M A ---> DIAGONALE
  254. *--- INFERIEURE STOCKEE EN LIGNE, DE LONGUEUR IDDL*(IDDL+1)/2
  255. *
  256. LONZ=IDDL
  257. SEGINI,MZZZ
  258. IPZ=MZZZ
  259. DO 120 IZ=1,LONZ
  260. DO 120 IKZ=1,LONZ
  261. ZZZZ(IKZ,IZ)=ZERO
  262. 120 CONTINUE
  263. * END DO
  264. IZZ=0
  265. DO 300 IB1=1,IDDL
  266. DO 400 IB2=1,IDDL
  267. IF (IB2.GE.IB1) THEN
  268. * IZZ=IZZ+1
  269. DO 500 IBB=1,NDDL
  270. ZZZZ(IB2,IB1)=ZZZZ(IB2,IB1)+BLO(IB1,IBB)*MBLO2.BLO(IB2,IBB)
  271. 500 CONTINUE
  272. * END DO
  273. ELSE
  274. ZZZZ(IB2,IB1)=ZZZZ(IB1,IB2)
  275. ENDIF
  276. 400 CONTINUE
  277. * END DO
  278. 300 CONTINUE
  279. * END DO
  280. * IF (IZZ.NE.LONZ) THEN
  281. * WRITE(IOIMP,*)'DYNE : IL MANQUE',(LONZ-IZZ),'TERMES DANS Z |'
  282. * ENDIF
  283. *
  284. *--------------------------------------------------------------*
  285. *--- ON VA MAINTENANT CREER UN OBJET RIGIDITE CONTENANT Z ---*
  286. *--------------------------------------------------------------*
  287. *
  288. NRIGEL=1
  289. NRIGE=8
  290. SEGINI,MRIGID
  291. ICHOLE=0
  292. IMGEO1=0
  293. IMGEO2=0
  294. IFORIG=IFOMOD
  295. ISUPEQ=0
  296. NBGEOR=0
  297. MTYMAT='RIGIDITE'
  298. COERIG(1)=UN
  299. IRIGEL(1,1)=IPOGEO
  300. IRIGEL(2,1)=0
  301. IRIGEL(3,1)=IPDES1
  302. IRIGEL(5,1)=0
  303. IRIGEL(6,1)=0
  304. NELRIG=1
  305. * SEGINI,IMATRI
  306. NLIGRP=LONZ
  307. NLIGRD=LONZ
  308. SEGINI,XMATRI
  309. DO 600 IRZ=1,LONZ
  310. DO 600 IKRZ=1,LONZ
  311. RE(IKRZ,IRZ,1)=ZZZZ(IKRZ,IRZ)
  312. 600 CONTINUE
  313. * END DO
  314. * IMATTT(1)=XMATRI
  315. * SEGDES,XMATRI
  316. IRIGEL(4,1)=xMATRI
  317. SEGDES,xMATRI
  318. IPRIGZ=MRIGID
  319. SEGDES,MRIGID
  320. *
  321. *--- FIN DU TRAITEMENT DE L'OBJET RIGIDITE "A"
  322. *
  323. ENDIF
  324. * -1
  325. *--- STOCKAGE DE M DANS UN VECTEUR DE LONGUEUR NDDL
  326. *
  327. IBB1=0
  328. INC=NDDL
  329. SEGINI,MVECT1
  330. DO 777 IB0=1,NDDL
  331. MVECT1.VECTBB(IB0)=ZERO
  332. 777 CONTINUE
  333. * END DO
  334. DO 888 IB1=1,VECTBB(/1)
  335. TTEST=VECTBB(IB1)
  336. IF (TTEST.NE.ZERO) THEN
  337. IBB1=IBB1+1
  338. MVECT1.VECTBB(IBB1)=VECTBB(IB1)
  339. ENDIF
  340. 888 CONTINUE
  341. * END DO
  342. IPM=MVECT1
  343. * SEGSUP,ICPA,ICPB
  344. *
  345. END
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  

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