Télécharger frigth.eso

Retour à la liste

Numérotation des lignes :

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

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