Télécharger kgrav1.eso

Retour à la liste

Numérotation des lignes :

  1. C KGRAV1 SOURCE CB215821 17/01/16 21:15:53 9279
  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.1) IRIGEL(7,ISOUS)= 2
  255.  
  256.  
  257. C_______________________________________________________________________
  258. C
  259. C coq3/dkt/dst/coq4
  260. C_______________________________________________________________________
  261. C
  262. IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.93) THEN
  263. c coq3/dkt/dst
  264. CALL KGRAV3(IPMAIL,XRG,IPOIN1,IPMATR,IDISS)
  265. ELSE IF (MELE.EQ.49) THEN
  266. c coq4
  267. CALL KGRAV2(IPMAIL,XRG,IPOIN1,IPMATR,IDISS,IPMINT)
  268. ELSE
  269. SEGSUP xMATRI
  270. IRIGEL(4,ISOUS)=0
  271. MOTERR(1:4)=NOMTP(MELE)
  272. MOTERR(5:12)='KGRAV1'
  273. CALL ERREUR(86)
  274. GOTO 9990
  275. ENDIF
  276. C
  277. C_______________________________________________________________________
  278. C_______________________________________________________________________
  279. C
  280. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  281. C_______________________________________________________________________
  282. C
  283.  
  284. SEGDES MELEME
  285. SEGDES IMODEL
  286.  
  287. C
  288. NOMID=MOFORC
  289. if(lsupfo)SEGSUP NOMID
  290. NOMID=MODEPL
  291. if(lsupdp)SEGSUP NOMID
  292. C
  293. SEGDES MINTE
  294. * INFO=IPINF
  295. * SEGSUP INFO
  296. C
  297. C ERREUR DANS KGRAV3
  298. C
  299. IF (IERR.NE.0) THEN
  300. IRET=0
  301. GOTO 888
  302. ENDIF
  303. 500 CONTINUE
  304. 888 CONTINUE
  305. SEGDES MMODEL
  306. SEGDES MRIGID
  307. GOTO 666
  308. C
  309. 9990 CONTINUE
  310. IRET=0
  311.  
  312. C
  313. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  314. C
  315.  
  316. NOMID=MOFORC
  317. if(lsupfo)SEGSUP NOMID
  318. NOMID=MODEPL
  319. if(lsupdp)SEGSUP NOMID
  320. C
  321. SEGDES MELEME
  322. SEGDES IMODEL
  323. C
  324. SEGDES MMODEL
  325. SEGSUP MRIGID
  326. C
  327. SEGDES MINTE
  328. * INFO=IPINF
  329. * SEGSUP INFO
  330. RETURN
  331. 666 CONTINUE
  332. RETURN
  333. END
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  

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