Télécharger kgrav1.eso

Retour à la liste

Numérotation des lignes :

  1. C KGRAV1 SOURCE PV 17/09/29 21:15:18 9578
  2. SUBROUTINE KGRAV1 (IPMODL,XRG,IPOIN1,IPRIG,IRET,IDISS,IFLAM)
  3. *
  4. *_______________________________________________________________________
  5. *
  6. * APPELE PAR KP
  7. *
  8. * ENTREES :
  9. * ========
  10. *
  11. * IPMODL: POINTEUR SUR UN MMODEL
  12. * IPOIN1: NUMERO DU POINT(VECTEUR) QUI DEFINIT LE SENS
  13. * LA PESANTEUR
  14. * XRG : COEFFICIENT MULTIPLICATEUR DE RIGIDITE
  15. * IDISS : 0 ---> MATRICE SYMETRIQUE
  16. * 1 ---> MATRICE DISSYMETRIQUE
  17. * IFLAM : 0 ---> SOUS TYPE RIGIDITE
  18. * 1 ---> SOUS TYPE MASSE
  19. *
  20. * SORTIES :
  21. * =========
  22. *
  23. * IPRIG POINTEUR SUR LA RIGIDITE CONSTRUITE
  24. * IRET 1 SI OK, 0 SINON
  25. *
  26. * I. Politopoulos juillet 1995
  27. *_______________________________________________________________________
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30. -INC CCOPTIO
  31. -INC CCREEL
  32. -INC CCHAMP
  33. -INC SMRIGID
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMINTE
  37. -INC SMMODEL
  38. LOGICAL lsupfo,lsupdp
  39. C
  40. SEGMENT NOTYPE
  41. CHARACTER*16 TYPE(NBTYPE)
  42. ENDSEGMENT
  43. C
  44. SEGMENT LIMODL(0)
  45. C C
  46. NHRM=NIFOUR
  47. IRET=1
  48. C
  49. C ACTIVATION DU MODELE
  50. C
  51. MMODEL=IPMODL
  52. SEGACT MMODEL
  53. NSOUS=KMODEL(/1)
  54. C
  55. C RECUPERATION DES MODELES
  56. C
  57. SEGINI,LIMODL
  58. DO 100 ISOUS=1,NSOUS
  59. IMODEL=KMODEL(ISOUS)
  60. SEGACT, IMODEL
  61. IF(FORMOD(1).EQ.'MECANIQUE'.OR.(FORMOD(1).EQ.'CHARGEMENT'.AND.
  62. & MATMOD(1).EQ.'PRESSION')) THEN
  63. LIMODL(**)=IMODEL
  64. ELSE
  65. SEGDES,IMODEL
  66. ENDIF
  67. 100 CONTINUE
  68. C
  69. NSOUS = LIMODL(/1)
  70. IF (NSOUS.LE.0) THEN
  71. SEGDES, MMODEL
  72. SEGSUP, LIMODL
  73. CALL ERREUR(610)
  74. RETURN
  75. ENDIF
  76. C
  77. C CREATION DE L'OBJET MATRICE DE RIGIDITE
  78. C
  79. NRIGE=7
  80. NRIGEL=NSOUS
  81. SEGINI MRIGID
  82. IPRIG=MRIGID
  83. IF (IFLAM.EQ.1) THEN
  84. MTYMAT='MASSE'
  85. ELSE
  86. MTYMAT='RIGIDITE'
  87. ENDIF
  88. IFORIG=IFOMOD
  89. ICHOLE=0
  90. IMGEO1=0
  91. IMGEO2=0
  92. ISUPEQ=0
  93. C
  94. C BOUCLE SUR LES SOUS ZONES
  95. C
  96. DO 499 ISOUS=1,NSOUS
  97. IRIGEL(4,ISOUS)=0
  98. COERIG(ISOUS)=1.D0
  99. 499 CONTINUE
  100. C_______________________________________________________________________
  101. C
  102. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  103. C_______________________________________________________________________
  104. C
  105. DO 500 ISOUS=1,NSOUS
  106. C
  107. C ON RECUPERE LINFORMATION GENERALES
  108. C
  109. IMODEL=KMODEL(ISOUS)
  110. SEGACT IMODEL
  111. IPMAIL=IMAMOD
  112. C
  113. C TRAITEMENT DU MODELE
  114. C
  115. MELEME=IMAMOD
  116. MELE=NEFMOD
  117. NFOR=FORMOD(/2)
  118. NMAT=MATMOD(/2)
  119.  
  120. C_______________________________________________________________________
  121. C
  122. C INFORMATION SUR L ELEMENT FINI
  123. C_______________________________________________________________________
  124. C
  125. * CALL ELQUOI(MELE,0,4,IPINF,IMODEL)
  126. IF (IERR.NE.0) THEN
  127. SEGDES IMODEL,MMODEL
  128. SEGSUP MRIGID
  129. IRET=0
  130. RETURN
  131. ENDIF
  132. * INFO=IPINF
  133. MFR =INFELE(13)
  134. LRE =INFELE(9)
  135. LW =INFELE(7)
  136. NDDL =INFELE(15)
  137. IELE=INFELE(14)
  138. * MINTE=INFELE(11)
  139. MINTE=infmod(6)
  140. IPMINT=MINTE
  141. C
  142. C INITIALISATION DE MINTE
  143. C
  144. SEGACT MINTE
  145. NBPGAU=POIGAU(/1)
  146.  
  147. C
  148. C ON RECUPERE LES MELEME
  149. C
  150. MELEME=IPMAIL
  151. SEGACT MELEME
  152.  
  153. NBNN =NUM(/1)
  154. NBELEM=NUM(/2)
  155.  
  156. C
  157. C ---------------------------------------------------------*
  158. C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES *
  159. C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE *
  160. C ---------------------------------------------------------*
  161. NLIGRP = INFELE(9)
  162. NLIGRD = INFELE(9)
  163. SEGINI DESCR
  164. IPDSCR=DESCR
  165. if(lnomid(1).ne.0) then
  166. nomid=lnomid(1)
  167. segact nomid
  168. modepl=nomid
  169. ndepl=lesobl(/2)
  170. ndum=lesfac(/2)
  171. lsupdp=.false.
  172. else
  173. lsupdp=.true.
  174. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  175. endif
  176. if(lnomid(2).ne.0) then
  177. nomid=lnomid(2)
  178. segact nomid
  179. moforc=nomid
  180. nforc=lesobl(/2)
  181. lsupfo=.false.
  182. else
  183. lsupfo=.true.
  184. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  185. endif
  186. C
  187. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  188. CALL ERREUR(5)
  189. SEGSUP DESCR,MRIGID
  190. SEGDES MMODEL,MELEME
  191. IRET=0
  192. RETURN
  193. ENDIF
  194. C
  195. C REMPLISSAGE DU SEGMENT DESCRIPTEUR
  196. C
  197. IDDL=1
  198. NCOMP=NDEPL
  199. NBNNS=NBNN
  200. IF (MFR.EQ.33) NCOMP=NDEPL-1
  201. IF (IFOUR.EQ.-3) THEN
  202. NCOMP=NDEPL-3
  203. NBNNS=NBNN-1
  204. ENDIF
  205. IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  206. NOMID=MODEPL
  207. SEGACT NOMID
  208. NOMID=MOFORC
  209. SEGACT NOMID
  210. DO 1004 INOEUD=1,NBNNS
  211. DO 1005 ICOMP=1,NCOMP
  212. NOMID=MODEPL
  213. LISINC(IDDL)=LESOBL(ICOMP)
  214. NOMID=MOFORC
  215. LISDUA(IDDL)=LESOBL(ICOMP)
  216. NOELEP(IDDL)=INOEUD
  217. NOELED(IDDL)=INOEUD
  218. IDDL=IDDL+1
  219. 1005 CONTINUE
  220. 1004 CONTINUE
  221. *
  222.  
  223.  
  224. NOMID=MODEPL
  225. SEGDES NOMID
  226. NOMID=MOFORC
  227. SEGDES NOMID
  228. SEGDES DESCR
  229.  
  230. C
  231. C ------------------------------------------------------------*
  232. C INITIALISATION DU SEGMENT IMATRI, CHAPEAU SUR LES SEGMENTS *
  233. C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES *
  234. C ------------------------------------------------------------*
  235. C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE
  236. NLIGRP=LRE
  237. NLIGRD=LRE
  238. NELRIG=NBELEM
  239. SEGINI xMATRI
  240. IPMATR=xMATRI
  241. C
  242. C------------------------------------------------------*
  243. C
  244. C TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID *
  245. C------------------------------------------------------*
  246. C
  247.  
  248. IRIGEL(1,ISOUS)=IPMAIL
  249. IRIGEL(2,ISOUS)=0
  250. IRIGEL(3,ISOUS)=IPDSCR
  251. IRIGEL(4,ISOUS)=xMATRI
  252. IRIGEL(5,ISOUS)=NHRM
  253. IF (IDISS.EQ.0) IRIGEL(7,ISOUS)= 0
  254. IF (IDISS.EQ.0) xmatri.symre=0
  255. IF (IDISS.EQ.1) IRIGEL(7,ISOUS)= 2
  256. IF (IDISS.EQ.1) xmatri.symre=2
  257.  
  258.  
  259. C_______________________________________________________________________
  260. C
  261. C coq3/dkt/dst/coq4
  262. C_______________________________________________________________________
  263. C
  264. IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.93) THEN
  265. c coq3/dkt/dst
  266. CALL KGRAV3(IPMAIL,XRG,IPOIN1,IPMATR,IDISS)
  267. ELSE IF (MELE.EQ.49) THEN
  268. c coq4
  269. CALL KGRAV2(IPMAIL,XRG,IPOIN1,IPMATR,IDISS,IPMINT)
  270. ELSE
  271. SEGSUP xMATRI
  272. IRIGEL(4,ISOUS)=0
  273. MOTERR(1:4)=NOMTP(MELE)
  274. MOTERR(5:12)='KGRAV1'
  275. CALL ERREUR(86)
  276. GOTO 9990
  277. ENDIF
  278. C
  279. C_______________________________________________________________________
  280. C_______________________________________________________________________
  281. C
  282. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  283. C_______________________________________________________________________
  284. C
  285.  
  286. SEGDES MELEME
  287. SEGDES IMODEL
  288.  
  289. C
  290. NOMID=MOFORC
  291. if(lsupfo)SEGSUP NOMID
  292. NOMID=MODEPL
  293. if(lsupdp)SEGSUP NOMID
  294. C
  295. SEGDES MINTE
  296. * INFO=IPINF
  297. * SEGSUP INFO
  298. C
  299. C ERREUR DANS KGRAV3
  300. C
  301. IF (IERR.NE.0) THEN
  302. IRET=0
  303. GOTO 888
  304. ENDIF
  305. 500 CONTINUE
  306. 888 CONTINUE
  307. SEGDES MMODEL
  308. SEGDES MRIGID
  309. GOTO 666
  310. C
  311. 9990 CONTINUE
  312. IRET=0
  313.  
  314. C
  315. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  316. C
  317.  
  318. NOMID=MOFORC
  319. if(lsupfo)SEGSUP NOMID
  320. NOMID=MODEPL
  321. if(lsupdp)SEGSUP NOMID
  322. C
  323. SEGDES MELEME
  324. SEGDES IMODEL
  325. C
  326. SEGDES MMODEL
  327. SEGSUP MRIGID
  328. C
  329. SEGDES MINTE
  330. * INFO=IPINF
  331. * SEGSUP INFO
  332. RETURN
  333. 666 CONTINUE
  334. RETURN
  335. END
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  

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