Télécharger famore.eso

Retour à la liste

Numérotation des lignes :

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

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