Télécharger frigie.eso

Retour à la liste

Numérotation des lignes :

  1. C FRIGIE SOURCE AM 16/04/12 21:15:46 8903
  2. SUBROUTINE FRIGIE(IPMODL,IPCAR,CRIGI,CMASS)
  3. **********************************************************************
  4. *
  5. * CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
  6. * CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
  7. * ... AU SIGNE PRES
  8. * CONTRIBUTION DE CHAQUE ELEMENT DE CHAQUE SS_ZONE DU MODELE
  9. * DE SECTION
  10. *
  11. **********************************************************************
  12. *
  13. * ENTREES:
  14. *
  15. * IPMODL = POINTEUR SUR UN OBJET MMODEL
  16. * IPCAR = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  17. *
  18. * SORTIES:
  19. *
  20. * CRIGI(12) ELEMENT DE REDUCTION DE LA RIGIDITE
  21. * CMASS(12) ELEMENT DE REDUCTION DE LA MASSE
  22. *
  23. ************************************************************************
  24. * Pierre Pegon (ISPRA) Juillet/Aout 1993
  25. ***********************************************************************
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. *
  29. -INC CCOPTIO
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMMODEL
  34. -INC SMINTE
  35. -INC CCHAMP
  36. C
  37. DIMENSION CRIGI(12),CMASS(12)
  38. *
  39. SEGMENT NOTYPE
  40. CHARACTER*16 TYPE(NBTYPE)
  41. ENDSEGMENT
  42. *
  43. SEGMENT MPTVAL
  44. INTEGER IPOS(NS) ,NSOF(NS)
  45. INTEGER IVAL(NCOSOU)
  46. CHARACTER*16 TYVAL(NCOSOU)
  47. ENDSEGMENT
  48. *
  49. CHARACTER*8 CMATE
  50. CHARACTER*(NCONCH) CONM
  51. CHARACTER*16 MOMODL(10)
  52. PARAMETER ( NINF=3 )
  53. INTEGER INFOS(NINF)
  54. LOGICAL lsupma,lsupca
  55. C
  56. NHRM=NIFOUR
  57. C
  58. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  59. C
  60. CALL QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRET5)
  61. IF (ISUP5.GT.1) RETURN
  62. C
  63. C ACTIVATION DU MODELE
  64. C
  65. MMODEL=IPMODL
  66. SEGACT MMODEL
  67. NSOUS=KMODEL(/1)
  68. C
  69. C MISE A ZERO DES RIGIDITES
  70. C
  71. DO IE1=1,12
  72. CRIGI(IE1)=0.D0
  73. CMASS(IE1)=0.D0
  74. ENDDO
  75. C____________________________________________________________________
  76. C
  77. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  78. C____________________________________________________________________
  79. C
  80. DO 1000 ISOUS=1,NSOUS
  81. *
  82. * INITIALISATION
  83. *
  84. NMATF=0
  85. NMATR=0
  86. MOMATR=0
  87. IVAMAT=0
  88. NCARA=0
  89. NCARF=0
  90. MOCARA=0
  91. IVACAR=0
  92. C
  93. C ON RECUPERE L INFORMATION GENERALE
  94. C
  95. IMODEL=KMODEL(ISOUS)
  96. SEGACT IMODEL
  97. IPMAIL=IMAMOD
  98. CONM =CONMOD
  99. *
  100. MELE=NEFMOD
  101. MELEME=IMAMOD
  102. C
  103. C TRAITEMENT DU MODELE
  104. C
  105. NFOR=FORMOD(/2)
  106. NMAT=MATMOD(/2)
  107. C
  108. C NATURE DU MATERIAU
  109. C
  110. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  111. IF (CMATE.EQ.' ')THEN
  112. CALL ERREUR(251)
  113. SEGDES IMODEL,MMODEL
  114. RETURN
  115. ENDIF
  116. IF(MATE.NE.1)THEN
  117. CALL ERREUR(635)
  118. SEGDES IMODEL,MMODEL
  119. RETURN
  120. ENDIF
  121. CALL TEMANF(INFIBR,NIFIBR)
  122. IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  123. CALL ERREUR(636)
  124. SEGDES IMODEL,MMODEL
  125. RETURN
  126. ENDIF
  127. *
  128. SEGACT MELEME
  129. NBNN=NUM(/1)
  130. NBELEM=NUM(/2)
  131. C____________________________________________________________________
  132. C
  133. C INFORMATION SUR L'ELEMENT FINI
  134. C____________________________________________________________________
  135. C
  136. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  137. * IF (IERR.NE.0) THEN
  138. * SEGDES IMODEL,MMODEL
  139. * RETURN
  140. * ENDIF
  141. * INFO=IPINF
  142. MFR =INFELE(13)
  143. IF (MFR.NE.47)THEN
  144. CALL ERREUR(637)
  145. SEGDES IMODEL,MMODEL
  146. RETURN
  147. ENDIF
  148. NBG =INFELE(6)
  149. NBGS =INFELE(4)
  150. LRE =INFELE(9)
  151. * MINTE=INFELE(11)
  152. minte=infmod(7)
  153. IPPORE=0
  154. IF(MFR.EQ.33) IPPORE=NBNN
  155. C
  156. C CREATION DU TABLEAU INFOS
  157. C
  158. CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  159. IF (IRTD.EQ.0)THEN
  160. SEGDES IMODEL,MMODEL
  161. * INFO=IPINF
  162. * SEGSUP INFO
  163. RETURN
  164. ENDIF
  165. IPMINT=MINTE
  166. SEGACT,MINTE
  167. *
  168. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  169. *
  170. if(lnomid(6).ne.0) then
  171. nomid=lnomid(6)
  172. segact nomid
  173. momatr=nomid
  174. nmatr=lesobl(/2)
  175. nmatf=lesfac(/2)
  176. lsupma=.false.
  177. else
  178. lsupma=.true.
  179. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  180. endif
  181. IF (MOMATR.EQ.0) THEN
  182. MOTERR(1:4)='MATE'
  183. MOTERR(5:8)=NOMTP(MELE)
  184. CALL ERREUR (76)
  185. GOTO 9990
  186. ENDIF
  187. *
  188. IF (NIFIBR.NE.8) THEN
  189. NBTYPE=1
  190. SEGINI NOTYPE
  191. MOTYPE=NOTYPE
  192. TYPE(1)='REAL*8'
  193. *
  194. ELSE
  195. NBTYPE=13
  196. SEGINI NOTYPE
  197. MOTYPE=NOTYPE
  198. DO I=1,NBTYPE
  199. TYPE(I)='REAL*8'
  200. ENDDO
  201. TYPE(10)='POINTEUREVOLUTIO'
  202. TYPE(11)='POINTEUREVOLUTIO'
  203. *
  204. ENDIF
  205. *
  206. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  207. & INFOS,3,IVAMAT)
  208. SEGSUP NOTYPE
  209. IF (IERR.NE.0) GOTO 9990
  210. NMATT=NMATR+NMATF
  211. *
  212. IF (ISUP5.EQ.1) THEN
  213. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  214. IF (IERR.NE.0) THEN
  215. ISUP5=0
  216. GOTO 9990
  217. ENDIF
  218. ENDIF
  219. *
  220. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  221. *
  222. if(lnomid(7).ne.0) then
  223. nomid=lnomid(7)
  224. segact nomid
  225. mocara=nomid
  226. ncara=lesobl(/2)
  227. ncarf=lesfac(/2)
  228. lsupca=.false.
  229. else
  230. lsupca=.true.
  231. CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  232. endif
  233. *
  234. NBTYPE=1
  235. SEGINI NOTYPE
  236. MOTYPE=NOTYPE
  237. TYPE(1)='REAL*8'
  238. *
  239. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  240. & INFOS,3,IVACAR)
  241. SEGSUP NOTYPE
  242. IF (IERR.NE.0) GOTO 9990
  243. NCARR=NCARA+NCARF
  244. *
  245. IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  246. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  247. IF (IERR.NE.0) THEN
  248. ISUP5=0
  249. GOTO 9990
  250. ENDIF
  251. ENDIF
  252. *
  253. * APPEL AU CALCUL PROPREMENT DIT
  254. *
  255. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  256. CALL FRIG22(MELE,IPMAIL,MINTE,NBGS,
  257. 1 IVAMAT,IVACAR,NMATT,NCARR,
  258. 2 CRIGI,CMASS)
  259. ELSE
  260. CALL FRIGI2(MELE,IPMAIL,MINTE,NBGS,
  261. 3 IVAMAT,IVACAR,NMATT,NCARR,
  262. 4 CRIGI,CMASS)
  263. ENDIF
  264. *
  265. 9990 CONTINUE
  266. *
  267. * DESACTIVATION DES SEGMENTS
  268. *
  269. SEGDES,MINTE,MELEME,IMODEL
  270. *
  271. IF(ISUP5.EQ.1)THEN
  272. CALL DTMVAL (IVAMAT,3)
  273. CALL DTMVAL (IVACAR,3)
  274. ELSE
  275. CALL DTMVAL (IVAMAT,1)
  276. CALL DTMVAL (IVACAR,1)
  277. ENDIF
  278. *
  279. IF (MOCARA.NE.0) THEN
  280. NOMID=MOCARA
  281. if(lsupca)SEGSUP NOMID
  282. END IF
  283. *
  284. IF (MOMATR.NE.0) THEN
  285. NOMID=MOMATR
  286. if(lsupma)SEGSUP NOMID
  287. END IF
  288. *
  289. * IF (IPINF .NE.0) THEN
  290. * INFO=IPINF
  291. * SEGSUP INFO
  292. * END IF
  293. *
  294. IF (IERR.NE.0) GO TO 888
  295. *
  296. 1000 CONTINUE
  297. *
  298. 888 CONTINUE
  299. SEGDES MMODEL
  300. *
  301. RETURN
  302. END
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  

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