Télécharger frigta.eso

Retour à la liste

Numérotation des lignes :

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

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