Télécharger frigie.eso

Retour à la liste

Numérotation des lignes :

  1. C FRIGIE SOURCE CB215821 19/08/20 21:17:53 10287
  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. RETURN
  114. ENDIF
  115. IF(MATE.NE.1)THEN
  116. CALL ERREUR(635)
  117. RETURN
  118. ENDIF
  119. CALL TEMANF(INFIBR,NIFIBR)
  120. IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  121. CALL ERREUR(636)
  122. RETURN
  123. ENDIF
  124. *
  125. SEGACT MELEME
  126. NBNN=NUM(/1)
  127. NBELEM=NUM(/2)
  128. C____________________________________________________________________
  129. C
  130. C INFORMATION SUR L'ELEMENT FINI
  131. C____________________________________________________________________
  132. C
  133. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  134. * IF (IERR.NE.0) THEN
  135. * RETURN
  136. * ENDIF
  137. * INFO=IPINF
  138. MFR =INFELE(13)
  139. IF (MFR.NE.47)THEN
  140. CALL ERREUR(637)
  141. RETURN
  142. ENDIF
  143. NBG =INFELE(6)
  144. NBGS =INFELE(4)
  145. LRE =INFELE(9)
  146. * MINTE=INFELE(11)
  147. minte=infmod(7)
  148. IPPORE=0
  149. IF(MFR.EQ.33) IPPORE=NBNN
  150. C
  151. C CREATION DU TABLEAU INFOS
  152. C
  153. CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  154. IF (IRTD.EQ.0)THEN
  155. * INFO=IPINF
  156. * SEGSUP INFO
  157. RETURN
  158. ENDIF
  159. IPMINT=MINTE
  160. SEGACT,MINTE
  161. *
  162. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  163. *
  164. if(lnomid(6).ne.0) then
  165. nomid=lnomid(6)
  166. segact nomid
  167. momatr=nomid
  168. nmatr=lesobl(/2)
  169. nmatf=lesfac(/2)
  170. lsupma=.false.
  171. else
  172. lsupma=.true.
  173. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  174. endif
  175. IF (MOMATR.EQ.0) THEN
  176. MOTERR(1:4)='MATE'
  177. MOTERR(5:8)=NOMTP(MELE)
  178. CALL ERREUR (76)
  179. GOTO 9990
  180. ENDIF
  181. *
  182. IF (NIFIBR.NE.8) THEN
  183. NBTYPE=1
  184. SEGINI NOTYPE
  185. MOTYPE=NOTYPE
  186. TYPE(1)='REAL*8'
  187. *
  188. ELSE
  189. NBTYPE=13
  190. SEGINI NOTYPE
  191. MOTYPE=NOTYPE
  192. DO I=1,NBTYPE
  193. TYPE(I)='REAL*8'
  194. ENDDO
  195. TYPE(10)='POINTEUREVOLUTIO'
  196. TYPE(11)='POINTEUREVOLUTIO'
  197. *
  198. ENDIF
  199. *
  200. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  201. & INFOS,3,IVAMAT)
  202. SEGSUP NOTYPE
  203. IF (IERR.NE.0) GOTO 9990
  204. NMATT=NMATR+NMATF
  205. *
  206. IF (ISUP5.EQ.1) THEN
  207. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  208. IF (IERR.NE.0) THEN
  209. ISUP5=0
  210. GOTO 9990
  211. ENDIF
  212. ENDIF
  213. *
  214. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  215. *
  216. if(lnomid(7).ne.0) then
  217. nomid=lnomid(7)
  218. segact nomid
  219. mocara=nomid
  220. ncara=lesobl(/2)
  221. ncarf=lesfac(/2)
  222. lsupca=.false.
  223. else
  224. lsupca=.true.
  225. CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  226. endif
  227. *
  228. NBTYPE=1
  229. SEGINI NOTYPE
  230. MOTYPE=NOTYPE
  231. TYPE(1)='REAL*8'
  232. *
  233. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  234. & INFOS,3,IVACAR)
  235. SEGSUP NOTYPE
  236. IF (IERR.NE.0) GOTO 9990
  237. NCARR=NCARA+NCARF
  238. *
  239. IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  240. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  241. IF (IERR.NE.0) THEN
  242. ISUP5=0
  243. GOTO 9990
  244. ENDIF
  245. ENDIF
  246. *
  247. * APPEL AU CALCUL PROPREMENT DIT
  248. *
  249. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  250. CALL FRIG22(MELE,IPMAIL,MINTE,NBGS,
  251. 1 IVAMAT,IVACAR,NMATT,NCARR,
  252. 2 CRIGI,CMASS)
  253. ELSE
  254. CALL FRIGI2(MELE,IPMAIL,MINTE,NBGS,
  255. 3 IVAMAT,IVACAR,NMATT,NCARR,
  256. 4 CRIGI,CMASS)
  257. ENDIF
  258. *
  259. 9990 CONTINUE
  260. *
  261. * DESACTIVATION DES SEGMENTS
  262. *
  263. *
  264. IF(ISUP5.EQ.1)THEN
  265. CALL DTMVAL (IVAMAT,3)
  266. CALL DTMVAL (IVACAR,3)
  267. ELSE
  268. CALL DTMVAL (IVAMAT,1)
  269. CALL DTMVAL (IVACAR,1)
  270. ENDIF
  271. *
  272. IF (MOCARA.NE.0) THEN
  273. NOMID=MOCARA
  274. if(lsupca)SEGSUP NOMID
  275. END IF
  276. *
  277. IF (MOMATR.NE.0) THEN
  278. NOMID=MOMATR
  279. if(lsupma)SEGSUP NOMID
  280. END IF
  281. *
  282. * IF (IPINF .NE.0) THEN
  283. * INFO=IPINF
  284. * SEGSUP INFO
  285. * END IF
  286. *
  287. IF (IERR.NE.0) GO TO 888
  288. *
  289. 1000 CONTINUE
  290. *
  291. 888 CONTINUE
  292. *
  293. END
  294.  
  295.  
  296.  
  297.  

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