Télécharger feqpr.eso

Retour à la liste

Numérotation des lignes :

feqpr
  1. C FEQPR SOURCE PV090527 25/01/07 14:42:38 12115
  2. SUBROUTINE FEQPR(IPMODL,IPCHM1,IPCHM2,IPCHP4,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C ENTREES:
  6. C ________
  7. C
  8. C IPMODL Pointeur sur un MMODEL
  9. C IPCHM1 Pointeur sur un MCHAML de CONTRAINTES
  10. C IPCHM2 Pointeur sur un MCHAML de CARACTERISTIQUES
  11. C
  12. C SORTIES:
  13. C ________
  14. C
  15. C IPCHP4 Pointeur sur un CHPOINT de forces aux noeuds
  16. C IRET = 1 OU 0 suivant succes ou pas (Message d'erreur
  17. C imprime dans ce cas)
  18. C_______________________________________________________________________
  19. C
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. C
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCOORD
  27. -INC CCHAMP
  28. -INC SMMODEL
  29. -INC SMCHAML
  30. -INC SMCHPOI
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMLENTI
  34. C
  35. SEGMENT NOTYPE
  36. CHARACTER*16 TYPE(NBTYPE)
  37. ENDSEGMENT
  38. C
  39. SEGMENT MPTVAL
  40. INTEGER IPOS(NS) ,NSOF(NS)
  41. INTEGER IVAL(NCOSOU)
  42. CHARACTER*16 TYVAL(NCOSOU)
  43. ENDSEGMENT
  44. C
  45. SEGMENT LIMODL(0)
  46. C
  47. PARAMETER ( NINF=3 )
  48. INTEGER INFOS(NINF)
  49. CHARACTER*(NCONCH) CONM
  50. C_______________________________________________________________________
  51. C
  52. C A T-ON BIEN UN MMODEL CHARGEMENT PRESSION
  53. C_______________________________________________________________________
  54. C
  55. MMODEL=IPMODL
  56. SEGACT,MMODEL
  57. NSOUS = MMODEL.KMODEL(/1)
  58. SEGINI, LIMODL
  59. DO ISOUS = 1,NSOUS
  60. IMODEL = MMODEL.KMODEL(ISOUS)
  61. SEGACT, IMODEL
  62. IF (FORMOD(1).EQ.'CHARGEMENT') THEN
  63. LIMODL(**) = IMODEL
  64. ENDIF
  65. ENDDO
  66. C
  67. NSOUS = LIMODL(/1)
  68. IF (NSOUS.EQ.0) THEN
  69. MOTERR(1:10)='un MMODEL '
  70. MOTERR(11:20)='CHARGEMENT'
  71. MOTERR(21:30)=' PRESSION '
  72. CALL ERREUR(881)
  73. RETURN
  74. ENDIF
  75. C
  76. C TEST DE NON REDONDANCES DES SOUS-MODELES
  77. C
  78. N1 = 1
  79. DO I = NSOUS,2,-1
  80. IMODE1 = LIMODL(I)
  81. DO J = (I-1),1,-1
  82. IMODE2 = LIMODL(J)
  83. IF (IMODE1.EQ.IMODE2) THEN
  84. LIMODL(I) = 0
  85. GOTO 10
  86. ELSE IF (IMODE1.IMAMOD.EQ.IMODE2.IMAMOD .AND.
  87. & IMODE1.CONMOD.EQ.IMODE2.CONMOD) THEN
  88. LIMODL(I) = 0
  89. GOTO 10
  90. ENDIF
  91. ENDDO
  92. N1 = N1 + 1
  93. 10 CONTINUE
  94. ENDDO
  95. C
  96. C CREATION DU MMODEL
  97. C
  98. J = 0
  99. SEGINI,MMODE1
  100. DO i = 1,NSOUS
  101. IF (LIMODL(I).GT.0) THEN
  102. j = j + 1
  103. MMODE1.KMODEL(J) = LIMODL(I)
  104. ENDIF
  105. ENDDO
  106. IPMOD0 = MMODE1
  107. SEGSUP, LIMODL
  108. C_______________________________________________________________________
  109. C
  110. C QUELQUES INITIALISATIONS
  111. C_______________________________________________________________________
  112. C
  113. ISUP1 = 0
  114. ISUP2 = 0
  115. IRET = 0
  116. IPCHP4 = 0
  117. MCHELM = 0
  118. MCHAML = 0
  119. IPCHE1 = 0
  120. IPCHE2 = 0
  121. C_______________________________________________________________________
  122. C
  123. C REDUCTION DES MCHAML EN ENTREE SUR LE MODELE
  124. C_______________________________________________________________________
  125. C
  126. C DEJA FAIT DANS BSIGMA
  127. IF (IPCHM1.NE.0) THEN
  128. CALL REDUAF(IPCHM1,IPMOD0,IPCHE1,0,IR,KER)
  129. IF (IR.NE.1) CALL ERREUR(KER)
  130. IF (IERR.NE.0) RETURN
  131. ENDIF
  132. C
  133. IF (IPCHM2.NE.0) THEN
  134. CALL REDUAF(IPCHM2,IPMOD0,IPCHE2,0,IR,KER)
  135. IF (IR.NE.1) CALL ERREUR(KER)
  136. IF (IERR.NE.0) RETURN
  137. ENDIF
  138. C_______________________________________________________________________
  139. C
  140. C VERIFICATION DES LIEUX SUPPORT DES MCHAML
  141. C_______________________________________________________________________
  142. C
  143. IF (IPCHE1.NE.0) THEN
  144. CALL QUESUP(IPMOD0,IPCHE1,3,0,ISUP1,IRET1C)
  145. IF (ISUP1.GT.1) RETURN
  146. ENDIF
  147. C
  148. IF (IPCHE2.NE.0) THEN
  149. CALL QUESUP(IPMOD0,IPCHE2,3,0,ISUP2,IR)
  150. IF (ISUP2.GT.1) RETURN
  151. ENDIF
  152. C_______________________________________________________________________
  153. C
  154. C ACTIVATION DU MODELE
  155. C_______________________________________________________________________
  156. C
  157. MMODEL=IPMOD0
  158. NSOUS = MMODEL.KMODEL(/1)
  159. DO IM = 1, NSOUS
  160. IMODEL = MMODEL.KMODEL(IM)
  161. ENDDO
  162. C
  163. C ACTIVATION DU MCHELM CONTENANT 'PRES'
  164. C
  165. IF (IPCHE1.NE.0) THEN
  166. MCHEL1 = IPCHE1
  167. ELSE
  168. MCHEL1 = IPCHE2
  169. ENDIF
  170. SEGACT, MCHEL1
  171. C
  172. C INITIALISATION DU MCHELM DE FORCES
  173. C
  174. N1 = NSOUS
  175. L1 = 6
  176. N3 = 6
  177. SEGINI, MCHELM
  178. IPCHE5 = MCHELM
  179. MCHELM.IFOCHE = IFOUR
  180. MCHELM.TITCHE = 'FORCES'
  181.  
  182. NBTYPE=1
  183. SEGINI,NOTYPE
  184. TYPE(1)='REAL*8'
  185. MOTYR8 = NOTYPE
  186. C
  187. C=======================================================================
  188. C
  189. C BOUCLE SUR LES MODELES ELEMENTAIRES
  190. C
  191. C=======================================================================
  192. C
  193. ISOUS = 0
  194. C
  195. DO 200 KISOUS = 1, NSOUS
  196. C
  197. C INITIALISATION
  198. C
  199. IVAMAT=0
  200. IVACAR=0
  201. IVASTR=0
  202. IVAFOR=0
  203. MOMATR=0
  204. MOCARA=0
  205. MOSTRS=0
  206. MOFORC=0
  207. IPMINT=0
  208. IPMIN1=0
  209. C
  210. C TRAITEMENT DU MODELE
  211. C
  212. IMODEL = MMODEL.KMODEL(KISOUS)
  213. ISOUS = ISOUS+1
  214. MELE = IMODEL.NEFMOD
  215. C
  216. C PETITE VERIFICATION SUR LE TYPE D'ELEMENT
  217. C
  218. IF (MELE.EQ.0) THEN
  219. C
  220. C ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR PRESSI POUR
  221. C LES ELEMENTS DE FORMULATION MELE
  222. C
  223. MOTERR(1:8)=NOMTP(MELE)
  224. CALL ERREUR(193)
  225. GOTO 9992
  226. ENDIF
  227. IPMAIL = IMODEL.IMAMOD
  228. CONM = IMODEL.CONMOD
  229. C
  230. C CREATION DU TABLEAU INFOS
  231. C
  232. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  233. IF (IRTD.EQ.0) GOTO 9992
  234. C_______________________________________________________________________
  235. C
  236. C ACTIVATION DU MELEME
  237. C_______________________________________________________________________
  238. C
  239. MELEME = IPMAIL
  240. SEGACT, MELEME
  241. NBNN = MELEME.NUM(/1)
  242. NBELEM = MELEME.NUM(/2)
  243. C_______________________________________________________________________
  244. C
  245. C INFORMATIONS SUR L'ELEMENT FINI
  246. C_______________________________________________________________________
  247. C
  248. NBPGAU= INFELE(4)
  249. MINTE = INFMOD(5)
  250. MINTE1= INFMOD(8)
  251. MFR = INFELE(13)
  252. MFR2 = NUMMFR(MELE)
  253. NSTRS = INFELE(16)
  254. C
  255. IPMINT= MINTE
  256. IPMIN1= MINTE1
  257. SEGACT, MINTE
  258. IPPORE= 0
  259. IF (MFR2.EQ.33.OR.MFR2.EQ.57.OR.MFR2.EQ.59) IPPORE = NBNN
  260. C
  261. IMACHE(ISOUS) = IPMAIL
  262. INFCHE(ISOUS,1)=0
  263. INFCHE(ISOUS,2)=0
  264. INFCHE(ISOUS,3)=NIFOUR
  265. INFCHE(ISOUS,4)=0
  266. INFCHE(ISOUS,5)=0
  267. INFCHE(ISOUS,6)=1
  268. C_______________________________________________________________________
  269. C
  270. C NOMS DE COMPOSANTES DE CONTRAINTES
  271. C_______________________________________________________________________
  272. C
  273. IF (IPCHE1.NE.0) THEN
  274. MOSTRS=LNOMID(4)
  275. NOMID=MOSTRS
  276. NSTR=LESOBL(/2)
  277. NFAC=LESFAC(/2)
  278. C
  279. C VERIFICATION DE LEUR PRESENCE
  280. C
  281. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYR8,1,INFOS,3,IVASTR)
  282. IF (IERR.NE.0) GOTO 9991
  283. C
  284. IF (ISUP1.EQ.1) THEN
  285. NSTRS = 1
  286. CALL VALCHE(IVASTR,NSTRS,IPMINT,IPPORE,MOSTRS,MELE)
  287. ENDIF
  288. ELSE
  289. MOMATR=LNOMID(6)
  290. NOMID=MOMATR
  291. NMATR=LESOBL(/2)
  292. NMATF=LESFAC(/2)
  293. C
  294. C VERIFICATION DE LEUR PRESENCE
  295. C
  296. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYR8,1,INFOS,3,IVAMAT)
  297. IF (IERR.NE.0) GOTO 9991
  298. C
  299. IF (ISUP2.EQ.1) THEN
  300. CALL VALCHE(IVAMAT,NMATR,IPMINT,IPPORE,MOMATR,MELE)
  301. ENDIF
  302. ENDIF
  303. C_______________________________________________________________________
  304. C
  305. C NOMS DE COMPOSANTES DE FORCES ET CREATION DU MCHAML DE FORCE
  306. C (CE MCHAML SERA TRANSFORME EN FIN DE SUBROUTINE EN CHPOINT)
  307. C_______________________________________________________________________
  308. C
  309. MOFORC = LNOMID(2)
  310. NOMID=MOFORC
  311. NFORC=LESOBL(/2)
  312. NFACF=LESFAC(/2)
  313. C
  314. N2=NFORC
  315. SEGINI, MCHAML
  316. ICHAML(ISOUS)=MCHAML
  317. C
  318. DO 110 ICOMP=1,NFORC
  319. NOMCHE(ICOMP)=LESOBL(ICOMP)
  320. TYPCHE(ICOMP)='REAL*8'
  321. 110 CONTINUE
  322. C
  323. IF (NFACF.NE.0) THEN
  324. IFAC = 0
  325. DO 111 ICOMP=(NFORC+1),N2
  326. IFAC = IFAC + 1
  327. NOMCHE(ICOMP)=LESFAC(IFAC)
  328. TYPCHE(ICOMP)='REAL*8'
  329. 111 CONTINUE
  330. ENDIF
  331. C
  332. C TAILLES DE MELVAL
  333. C
  334. N1EL=NBELEM
  335. N1PTEL=NBNN
  336. NBPTEL=NBPGAU
  337. NEL =N1EL
  338. C
  339. C CREATION DU MELVAL DE FORCES
  340. C
  341. NS=1
  342. NCOSOU=NFORC+NFACF
  343. SEGINI, MPTVAL
  344. IVAFOR=MPTVAL
  345. DO 100 ICOMP=1,NCOSOU
  346. N2PTEL=0
  347. N2EL=0
  348. SEGINI, MELVAL
  349. IELVAL(ICOMP)=MELVAL
  350. IVAL(ICOMP)=MELVAL
  351. 100 CONTINUE
  352. C_______________________________________________________________________
  353. C
  354. C NOMS DE COMPOSANTES DE CARACTERISTIQUES (FACULTATIF)
  355. C_______________________________________________________________________
  356. C
  357. NBROBL=0
  358. NBRFAC=0
  359. NOMID=0
  360. IVECT=0
  361. NOTYPE = MOTYR8
  362. C
  363. C EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  364. C
  365. IF(MFR.EQ.72.AND.IFOUR.EQ.-2)THEN
  366. C
  367. NBRFAC=1
  368. SEGINI, NOMID
  369. LESFAC(1)='DIM3'
  370. C
  371. C EPAISSEUR DANS LE CAS DES COQUES 2D COQ2
  372. C
  373. ELSEIF(MFR.EQ.74.AND.MELE.EQ.44.AND.IFOUR.EQ.-2)THEN
  374. C
  375. NBRFAC=1
  376. SEGINI, NOMID
  377. LESFAC(1)='DIM3'
  378. C
  379. C EPAISSEUR DANS LE CAS DES COQUES EPAISSES
  380. C
  381. ELSEIF (MFR.EQ.74.AND.MFR2.EQ.5) THEN
  382. NBROBL=1
  383. NBRFAC=0
  384. SEGINI, NOMID
  385. LESOBL(1)='EPAI'
  386. C
  387. C EPAISSEUR ET RAYON EXTERNE DANS LE CAS DES TUYAUX
  388. C
  389. ELSEIF (MFR.EQ.74.AND.MFR2.EQ.13) THEN
  390. NBROBL=2
  391. NBRFAC=4
  392. SEGINI, NOMID
  393. LESOBL(1)='EPAI'
  394. LESOBL(2)='RAYO'
  395. LESFAC(1)='RACO'
  396. LESFAC(2)='VX'
  397. LESFAC(3)='VY'
  398. LESFAC(4)='VZ'
  399. C
  400. ENDIF
  401. MOCARA=NOMID
  402. MOTYPE=NOTYPE
  403. C
  404. NCARA=NBROBL
  405. NCARF=NBRFAC
  406. NCARR=NCARA+NCARF
  407. C
  408. IF (IPCHE2.NE.0) THEN
  409. IF (MOCARA.NE.0) THEN
  410. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  411. + IVACAR)
  412. IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  413. SEGSUP, NOMID
  414. IF (IERR.NE.0) GOTO 9990
  415. IF (ISUP2.EQ.1) THEN
  416. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  417. IF (IERR.NE.0)THEN
  418. ISUP2=0
  419. GOTO 9990
  420. ENDIF
  421. ENDIF
  422. ELSE
  423. IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  424. SEGSUP, NOMID
  425. ENDIF
  426. ELSE IF (NCARA.GT.0) THEN
  427. IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  428. SEGSUP, NOMID
  429. MOTERR(1:8)='CARACTER'
  430. MOTERR(9:12)=NOMTP(MELE)
  431. MOTERR(13:20)='FEQPR'
  432. CALL ERREUR(145)
  433. GOTO 9990
  434. ENDIF
  435. C_______________________________________________________________________
  436. C
  437. C CALCUL DES FORCES EQUIVALENTES
  438. C_______________________________________________________________________
  439. C
  440. IF (IPCHE1.NE.0) THEN
  441. MPTVAL=IVASTR
  442. ELSE
  443. MPTVAL=IVAMAT
  444. ENDIF
  445. IVAPRE = IVAL(1)
  446. C
  447. C - ELEMENTS DE FORMULATION MASSIF
  448. C
  449. IF (MFR2.EQ.1) THEN
  450. XP=0.D0
  451. IF (MELE.EQ.2.OR.MELE.EQ.3.OR.MELE.EQ.79.OR.MELE.EQ.80) THEN
  452. CALL FPMA2D(IVAPRE,IPMAIL,0,IPMINT,IVAFOR,IVACAR,XP,0,0)
  453. ELSE IF(MELE.EQ.4.OR.MELE.EQ.6.OR.MELE.EQ.8.OR.
  454. + MELE.EQ.10.OR.MELE.EQ.81.OR.MELE.EQ.82.OR.
  455. + MELE.EQ.83) THEN
  456. IF (IDIM.EQ.3) THEN
  457. CALL FPMA3D(IVAPRE,IPMAIL,0,IPMINT,IVAFOR,XP,0,0)
  458. ELSE
  459. C ERREUR, APPLICATION PRESSION SUR SURFACE DANS UN PB 2D
  460. CALL ERREUR(820)
  461. GOTO 9990
  462. ENDIF
  463. ELSE IF (MELE.EQ.45) THEN
  464. CALL FPMA1D(IVAPRE,IPMAIL,0,IPMINT,IVAFOR,XP,0,0)
  465. ELSE
  466. C ERREUR, ELEMENT NON IMPLEMENTE
  467. MOTERR(1:4)=NOMTP(MELE)
  468. MOTERR(5:12)='FEQPR '
  469. CALL ERREUR(86)
  470. GOTO 9990
  471. ENDIF
  472. C
  473. C - ELEMENTS DE FORMULATION COQUES
  474. C
  475. ELSE IF (MFR2.EQ.3.OR.MFR2.EQ.5.OR.MFR2.EQ.9) THEN
  476. C
  477. IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45.OR.
  478. + MELE.EQ.93.OR.MELE.EQ.44.OR.MELE.EQ.49.OR.
  479. + MELE.EQ.41.OR.MELE.EQ.56) THEN
  480. C VERIFICATION DE L ORIENTATION DU IPMAIL
  481. CALL ECROBJ('MAILLAGE',IPMAIL)
  482. CALL VERSEN
  483. CALL LIROBJ('MAILLAGE',IPMAIL,1,IRETOU)
  484. IF (IERR.NE.0) GOTO 9990
  485. IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45
  486. + .OR.MELE.EQ.93) THEN
  487. CALL FPCO3D(IVAPRE,IPMAIL,IVAFOR)
  488. ELSE IF (MELE.EQ.44) THEN
  489. CALL FPCO2D(IVAPRE,IPMAIL,IVAFOR,IVACAR)
  490. ELSE IF (MELE.EQ.49) THEN
  491. IPT1 = IPMAIL
  492. SEGACT, IPT1
  493. CALL FPCOQ4(IVAPRE,IPMAIL,IPMINT,IVAFOR)
  494. ELSE IF (MELE.EQ.41.OR.MELE.EQ.56) THEN
  495. IPT1 = IPMAIL
  496. SEGACT, IPT1
  497. CALL FPCOQ8(IVAPRE,IPMAIL,IPMINT,IVACAR,IPMIN1,IVAFOR)
  498. ENDIF
  499. ELSE
  500. C ERREUR, ELEMENT NON IMPLEMENTE
  501. MOTERR(1:4)=NOMTP(MELE)
  502. MOTERR(5:12)='FEQPR '
  503. CALL ERREUR(86)
  504. GOTO 9990
  505. ENDIF
  506. C
  507. ELSE IF (MFR2.EQ.13) THEN
  508. C
  509. C - ELEMENTS TUYAU
  510. C
  511. CALL FPELTU(IVAPRE,IVACAR,IPMAIL,I,IVAFOR)
  512. C
  513. C - SINON TENTATIVE D'UTILISATION D'UNE OPTION NON IMPLEMENTEE
  514. C
  515. ELSE
  516. CALL ERREUR(251)
  517. GOTO 9990
  518. ENDIF
  519. C
  520. C DESACTIVATION AVANT DE PASSER A LA SOUS ZONE SUIVANTE
  521. C
  522. C
  523. IF(ISUP1.EQ.1)THEN
  524. CALL DTMVAL(IVASTR,3)
  525. ELSE
  526. CALL DTMVAL(IVASTR,1)
  527. ENDIF
  528. C
  529. CALL DTMVAL(IVAFOR,1)
  530. C
  531. IF(ISUP2.EQ.1)THEN
  532. CALL DTMVAL(IVAMAT,3)
  533. CALL DTMVAL(IVACAR,3)
  534. ELSE
  535. CALL DTMVAL(IVAMAT,1)
  536. CALL DTMVAL(IVACAR,1)
  537. ENDIF
  538. C
  539. IF (IERR.NE.0) GO TO 9990
  540. C
  541. C=======================================================================
  542. C
  543. C FIN DE BOUCLE SUR LES MODELES ELEMENTAIRES
  544. C
  545. C=======================================================================
  546. 200 CONTINUE
  547. C_______________________________________________________________________
  548. C
  549. C TRANSFORMATION DU CHAMELEM EN CHPOINT
  550. C_______________________________________________________________________
  551. C
  552. CALL CHAMPO(IPCHE5,0,IPCHP4,IRETOU)
  553. CALL DTCHAM(IPCHE5)
  554. IF (IRETOU.EQ.0) GOTO 9000
  555. C
  556. C FIN NORMALE
  557. C
  558. IRET = 1
  559. GOTO 9000
  560. C_______________________________________________________________________
  561. C
  562. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  563. C_______________________________________________________________________
  564. C
  565. 9990 CONTINUE
  566. IF (MCHAML.NE.0) SEGSUP, MCHAML
  567. CALL DTMVAL(IVAFOR,3)
  568. C
  569. 9991 CONTINUE
  570. C
  571. 9992 CONTINUE
  572. IF (MCHELM.NE.0) SEGSUP, MCHELM
  573. IRET = 0
  574. C_______________________________________________________________________
  575. C
  576. C DERNIERES DESACTIVATION AVANT DE QUITTER
  577. C_______________________________________________________________________
  578. C
  579. 9000 CONTINUE
  580. NOTYPE = MOTYR8
  581. SEGSUP,NOTYPE
  582.  
  583. C RETURN
  584. END
  585.  
  586.  
  587.  
  588.  
  589.  

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