Télécharger feqpr.eso

Retour à la liste

Numérotation des lignes :

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

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