Télécharger feqpr.eso

Retour à la liste

Numérotation des lignes :

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

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