Télécharger famore.eso

Retour à la liste

Numérotation des lignes :

  1. C FAMORE SOURCE AM 16/04/12 21:15:37 8903
  2. SUBROUTINE FAMORE(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. MOMATR=0
  85. IVAMAT=0
  86. MOCARA=0
  87. IVACAR=0
  88. C
  89. C ON RECUPERE L INFORMATION GENERALE
  90. C
  91. IMODEL=KMODEL(ISOUS)
  92. SEGACT IMODEL
  93. IPMAIL=IMAMOD
  94. CONM =CONMOD
  95. *
  96. MELE=NEFMOD
  97. MELEME=IMAMOD
  98. SEGACT MELEME
  99. NBNN=NUM(/1)
  100. NBELEM=NUM(/2)
  101. C
  102. C TRAITEMENT DU MODELE
  103. C
  104. C* NFOR=FORMOD(/2)
  105. C* NMAT=MATMOD(/2)
  106. C
  107. C NATURE DU MATERIAU
  108. C
  109. C* CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  110. CMATE = CMATEE
  111. MATE = IMATEE
  112. INFIBR = INATUU
  113. C* IF (CMATE.EQ.' ')THEN
  114. C* CALL ERREUR(251)
  115. C* GOTO 9993
  116. C* ENDIF
  117. IF(MATE.NE.1)THEN
  118. CALL ERREUR(635)
  119. GOTO 9993
  120. ENDIF
  121. CALL TEMANF(INFIBR,NIFIBR)
  122. IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  123. CALL ERREUR(636)
  124. GOTO 9993
  125. ENDIF
  126. *
  127. C____________________________________________________________________
  128. C
  129. C INFORMATION SUR L'ELEMENT FINI
  130. C____________________________________________________________________
  131. C
  132. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  133. * IF (IERR.NE.0) GOTO 9993
  134. MFR =INFELE(13)
  135. IF (MFR.NE.47)THEN
  136. CALL ERREUR(637)
  137. GOTO 9993
  138. ENDIF
  139. NBG =INFELE(6)
  140. NBGS =INFELE(4)
  141. LRE =INFELE(9)
  142. * MINTE=INFELE(11)
  143. MINTE=INFMOD(7)
  144. IPMINT=MINTE
  145. SEGACT,MINTE
  146. IPPORE=0
  147. IF(MFR.EQ.33) IPPORE=NBNN
  148. C
  149. C CREATION DU TABLEAU INFOS
  150. C
  151. CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  152. IF (IRTD.EQ.0) GOTO 9992
  153. *
  154. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  155. if(lnomid(6).ne.0) then
  156. nomid=lnomid(6)
  157. segact nomid
  158. momatr=nomid
  159. nmatr=lesobl(/2)
  160. nmatf=lesfac(/2)
  161. lsupma=.false.
  162. else
  163. lsupma=.true.
  164. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  165. endif
  166. IF (MOMATR.EQ.0) THEN
  167. MOTERR(1:4)='MATE'
  168. MOTERR(5:8)=NOMTP(MELE)
  169. CALL ERREUR (76)
  170. GOTO 9990
  171. ENDIF
  172. *
  173. IF (NIFIBR.NE.8) THEN
  174. NBTYPE=1
  175. SEGINI NOTYPE
  176. MOTYPE=NOTYPE
  177. TYPE(1)='REAL*8'
  178. *
  179. ELSE
  180. NBTYPE=13
  181. SEGINI NOTYPE
  182. MOTYPE=NOTYPE
  183. DO I=1,NBTYPE
  184. TYPE(I)='REAL*8'
  185. ENDDO
  186. TYPE(10)='POINTEUREVOLUTIO'
  187. TYPE(11)='POINTEUREVOLUTIO'
  188. ENDIF
  189. *
  190. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  191. & INFOS,3,IVAMAT)
  192. SEGSUP NOTYPE
  193. *
  194. IF (IERR.NE.0) GOTO 9990
  195. NMATT=NMATR+NMATF
  196. *
  197. IF (ISUP5.EQ.1) THEN
  198. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  199. IF (IERR.NE.0) THEN
  200. ISUP5=0
  201. GOTO 9990
  202. ENDIF
  203. ENDIF
  204. *
  205. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  206. *
  207. if(lnomid(7).ne.0) then
  208. nomid=lnomid(7)
  209. segact nomid
  210. mocara=nomid
  211. ncara=lesobl(/2)
  212. ncarf=lesfac(/2)
  213. lsupca=.false.
  214. else
  215. lsupca=.true.
  216. CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  217. endif
  218. *
  219. NBTYPE=1
  220. SEGINI NOTYPE
  221. MOTYPE=NOTYPE
  222. TYPE(1)='REAL*8'
  223. *
  224. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  225. & INFOS,3,IVACAR)
  226. SEGSUP NOTYPE
  227. IF (IERR.NE.0) GOTO 9990
  228. NCARR=NCARA+NCARF
  229. *
  230. IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  231. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  232. IF (IERR.NE.0) THEN
  233. ISUP5=0
  234. GOTO 9990
  235. ENDIF
  236. ENDIF
  237. *
  238. * APPEL AU CALCUL PROPREMENT DIT
  239. *
  240. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  241. CALL FAMO22(MELE,IPMAIL,IPMINT,NBGS,
  242. 1 IVAMAT,IVACAR,NMATT,NCARR,
  243. 2 CRIGI,CMASS)
  244. ELSE
  245. CALL FAMOR2(MELE,IPMAIL,IPMINT,NBGS,
  246. 3 IVAMAT,IVACAR,NMATT,NCARR,
  247. 4 CRIGI,CMASS)
  248. ENDIF
  249. *
  250. 9990 CONTINUE
  251. *
  252. * DESACTIVATION DES SEGMENTS
  253. *
  254. IF(ISUP5.EQ.1)THEN
  255. CALL DTMVAL (IVAMAT,3)
  256. CALL DTMVAL (IVACAR,3)
  257. ELSE
  258. CALL DTMVAL (IVAMAT,1)
  259. CALL DTMVAL (IVACAR,1)
  260. ENDIF
  261. *
  262. IF (MOCARA.NE.0) THEN
  263. NOMID=MOCARA
  264. if(lsupca)SEGSUP NOMID
  265. END IF
  266. *
  267. IF (MOMATR.NE.0) THEN
  268. NOMID=MOMATR
  269. if(lsupma)SEGSUP NOMID
  270. END IF
  271. *
  272. 9992 CONTINUE
  273. SEGDES,MINTE
  274. 9993 CONTINUE
  275. SEGDES MELEME,IMODEL
  276. *
  277. IF (IERR.NE.0) GOTO 888
  278. *
  279. 1000 CONTINUE
  280. *
  281. 888 CONTINUE
  282. SEGDES,MMODEL
  283. *
  284. RETURN
  285. END
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  

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