Télécharger gnflp.eso

Retour à la liste

Numérotation des lignes :

  1. C GNFLP SOURCE PV 17/10/03 21:15:30 9581
  2. SUBROUTINE GNFLP(IPMODL,IPCHE1,IPCHP1,IPCHE2,IPCHP4,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C IPMODL MMODEL
  6. C IPCHE1 MCHAML
  7. C IPCHE2 MCHAML de caract{ristiques (facultatif)
  8. C IPCHP4 CHPOINT resultat
  9. C IRET =1 OU 0 suivant succes ou pas (Message d'erreur)
  10. C_______________________________________________________________________
  11. C
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8(A-H,O-Z)
  14. C
  15. -INC CCOPTIO
  16. -INC CCHAMP
  17. -INC SMCHAML
  18. -INC SMCHPOI
  19. -INC SMELEME
  20. -INC SMCOORD
  21. -INC SMMODEL
  22. -INC SMINTE
  23. *
  24. SEGMENT INFO
  25. INTEGER INFELL(JG)
  26. ENDSEGMENT
  27.  
  28. SEGMENT NOTYPE
  29. CHARACTER*16 TYPE(NBTYPE)
  30. ENDSEGMENT
  31. *
  32. SEGMENT MPTVAL
  33. INTEGER IPOS(NS) ,NSOF(NS)
  34. INTEGER IVAL(NCOSOU)
  35. CHARACTER*16 TYVAL(NCOSOU)
  36. ENDSEGMENT
  37. *
  38. CHARACTER*8 CMATE
  39. CHARACTER*(NCONCH) CONM
  40. PARAMETER ( NINF=3 )
  41. INTEGER INFOS(NINF)
  42. LoGICAL lsupfo
  43.  
  44. IRET = 0
  45. IPCHP4 = 0
  46. IPCHE5 = 0
  47. *
  48. * Verification du lieu support du MCHAML
  49. *
  50. IF (IPCHE1.NE.0) THEN
  51. CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP1,IRET1)
  52. IF (ISUP1.GT.1) THEN
  53. CALL ERREUR(609)
  54. RETURN
  55. ENDIF
  56. IPCHM1 = IPCHE1
  57. *
  58. * PASSAGE DU CHPOINT EN MCHAML
  59. *
  60. ELSE
  61. CALL CHAME1(0,IPMODL,IPCHP1,'VOLUMIQUE',IPCHM1,1)
  62. IF (IERR.NE.0) RETURN
  63. ISUP1 = 1
  64. ENDIF
  65. *
  66. * Verification du lieu support du MCHAML de caracteristiques
  67. *
  68. IF (IPCHE2.NE.0) THEN
  69. CALL QUESUP(IPMODL,IPCHE2,3,1,ISUP2,IRET2)
  70. IF (ISUP2.GT.1) THEN
  71. CALL ERREUR(609)
  72. RETURN
  73. ENDIF
  74. ENDIF
  75. *_______________________________________________________________________
  76. *
  77. * ACTIVATION DU MODELE
  78. *_______________________________________________________________________
  79. *
  80. MMODEL=IPMODL
  81. SEGACT MMODEL
  82. NSOUS=KMODEL(/1)
  83. C Petite verification sur le MODELE : uniquement FORMULATION POREUX
  84. DO ISOUS = 1, NSOUS
  85. IMODEL=KMODEL(ISOUS)
  86. SEGACT,IMODEL
  87. NFOR=FORMOD(/2)
  88. IF (NFOR.EQ.1) THEN
  89. IF (FORMOD(1).NE.'POREUX') THEN
  90. MOTERR(1:8)=FORMOD(1)
  91. CALL ERREUR(193)
  92. GOTO 9900
  93. ENDIF
  94. C* ELSE IF (NFOR.GT.1) THEN
  95. ELSE
  96. MOTERR(1:8)=FORMOD(1)
  97. CALL ERREUR(193)
  98. GOTO 9900
  99. ENDIF
  100. ENDDO
  101. C
  102. C ACTIVATION DU CHAMP EN ENTREE
  103. C
  104. MCHEL1=IPCHM1
  105. SEGACT,MCHEL1
  106. C
  107. C INITIALISATION DU MCHELM DE VALEURS NODALES
  108. C
  109. L1=6
  110. N1=NSOUS
  111. N3=5
  112. SEGINI,MCHELM
  113. IPCHE5=MCHELM
  114. IFOCHE=IFOUR
  115. TITCHE='FORCES'
  116. C_______________________________________________________________________
  117. C
  118. C BOUCLE SUR LES SOUS ZONES
  119. C_______________________________________________________________________
  120. C
  121. DO 200 ISOUS=1,NSOUS
  122. C
  123. C INITIALISATION
  124. C
  125. IVACAR=0
  126. IVAFOR=0
  127. IVAVCO=0
  128. MOCARA=0
  129. MOFORC=0
  130. MOVECO=0
  131. C
  132. C TRAITEMENT DU MODELE
  133. C
  134. IMODEL=KMODEL(ISOUS)
  135. IIPDPG = imodel.IPDPGE
  136. IIPDPG = IPTPOI(IIPDPG)
  137. MELE=NEFMOD
  138. IPMAIL=IMAMOD
  139. CONM =CONMOD
  140. C____________________________________________________________________
  141. C
  142. C ACTIVATION DU MELEME
  143. C
  144. MELEME=IPMAIL
  145. SEGACT MELEME
  146. NBNN=NUM(/1)
  147. NBELEM=NUM(/2)
  148. C
  149. C CREATION DU TABLEAU INFOS
  150. C
  151. CALL IDENT(IPMAIL,CONM,IPCHM1,IPCHE2,INFOS,IRTD)
  152. IF (IRTD.EQ.0) GOTO 9990
  153. C_______________________________________________________________________
  154. C
  155. C INFORMATIONS SUR L'ELEMENT FINI
  156. C_______________________________________________________________________
  157. C
  158. if(infmod(/1).lt.5) then
  159. CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  160. IF (IERR.NE.0) GOTO 9990
  161. INFO=IPINF
  162. NBPGAU= INFELL(4)
  163. NBG = INFELL(6)
  164. MINTE = INFELL(11)
  165. MINTE1= INFELL(12)
  166. IPMINT= MINTE
  167. IPMIN1= MINTE1
  168. MFR = INFELL(13)
  169. LW = INFELL(7)
  170. IELE = INFELL(14)
  171. IPORE = INFELL(8)
  172. segsup info
  173. ELSE
  174. NBPGAU= INFELE(4)
  175. NBG = INFELE(6)
  176. * MINTE = INFELE(11)
  177. MINTE=INFMOD(5)
  178. MINTE1= INFMOD(8)
  179. IPMINT= MINTE
  180. IPMIN1= MINTE1
  181. MFR = INFELE(13)
  182. LW = INFELE(7)
  183. IELE = INFELE(14)
  184. IPORE = INFELE(8)
  185. ENDIF
  186. IPPORE=0
  187. IF(MFR.EQ.33) THEN
  188. IPPORE=NBNN
  189. IDECAP=1
  190. ELSE IF(MFR.EQ.57) THEN
  191. IPPORE=NBNN
  192. IDECAP=2
  193. ELSE IF(MFR.EQ.59) THEN
  194. IPPORE=NBNN
  195. IDECAP=3
  196. ENDIF
  197. NHRM = NIFOUR
  198. C
  199. SEGACT MINTE
  200. NBNO=SHPTOT(/2)
  201. C
  202. C RECOPIE DU MCHELM
  203. C
  204. IMACHE(ISOUS)=IPMAIL
  205. CONCHE(ISOUS)=CONMOD
  206. INFCHE(ISOUS,1)=0
  207. INFCHE(ISOUS,2)=0
  208. INFCHE(ISOUS,3)=NIFOUR
  209. INFCHE(ISOUS,4)=0
  210. INFCHE(ISOUS,5)=0
  211. C_______________________________________________________________________
  212. C
  213. C NOMS DE COMPOSANTES EN SORTIE
  214. C_______________________________________________________________________
  215. C
  216. if(lnomid(2).ne.0) then
  217. lsupfo=.false.
  218. moforc=lnomid(2)
  219. nomid=moforc
  220. segact nomid
  221. NFORC=lesobl(/2)
  222. nfac=lesfac(/2)
  223. else
  224. lsupfo=.true.
  225. CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NFAC)
  226. NOMID=MOFORC
  227. SEGACT NOMID
  228. endif
  229. NCOMP=IDECAP
  230. C
  231. C CREATION DU MCHAML
  232. C
  233. N2=NCOMP
  234. SEGINI MCHAML
  235. ICHAML(ISOUS)=MCHAML
  236. DO 110 ICOMP=1,NCOMP
  237. IPRDEC=NFORC-IDECAP+ICOMP
  238. NOMCHE(ICOMP)=LESOBL(IPRDEC)
  239. TYPCHE(ICOMP)='REAL*8'
  240. 110 CONTINUE
  241. *_______________________________________________________________________
  242. *
  243. * TRAITEMENT DU CHAMP DE VALEURS EN ENTREE
  244. *_______________________________________________________________________
  245. *
  246. * ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  247. * MAIS ON LES MET EN FACULTATIF
  248. *
  249. * CAS JOINTS
  250. *
  251. IF((MELE.GE.108.AND.MELE.LE.110).OR.
  252. . (MELE.GE.185.AND.MELE.LE.190)) THEN
  253.  
  254. IF(IFOUR.LE.0) THEN
  255. * CAS PLAN
  256. NCOVEC=3
  257. ELSE IF (IFOUR.EQ.2) THEN
  258. * 3D
  259. NCOVEC=4
  260. ENDIF
  261. ELSE
  262.  
  263. IF(IFOUR.LE.0) THEN
  264. * CONTRAINTES PLANES - DEFORMATIONS PLANES
  265. * DEFO PLAN GENE
  266. * AXISYMETRIQUE
  267. NCOVEC=2
  268.  
  269. ELSE IF (IFOUR.GT.0) THEN
  270. * FOURIER
  271. * 3D
  272. NCOVEC=3
  273. ENDIF
  274. ENDIF
  275. *
  276. * PUIS ON CREE LE SEGMENT MOVECO
  277. *
  278. NBROBL=0
  279. NBRFAC=NCOVEC*IDECAP
  280. *
  281. NVECO=NBRFAC
  282. SEGINI NOMID
  283. MOVECO=NOMID
  284.  
  285. IF((MELE.GE.108.AND.MELE.LE.110).OR.
  286. . (MELE.GE.185.AND.MELE.LE.190)) THEN
  287.  
  288. DO 121 IPR=1,IDECAP
  289. IPRDEC = (IPR-1)*NCOVEC
  290. IF(IPR.EQ.1) THEN
  291. LESFAC(IPRDEC+1)='VCPH'
  292. LESFAC(IPRDEC+2)='VCPB'
  293. LESFAC(IPRDEC+3)='VCP1'
  294. IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCP2'
  295. ELSE IF(IPR.EQ.2) THEN
  296. LESFAC(IPRDEC+1)='VCQH'
  297. LESFAC(IPRDEC+2)='VCQB'
  298. LESFAC(IPRDEC+3)='VCQ1'
  299. IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCQ2'
  300. ELSE IF(IPR.EQ.3) THEN
  301. LESFAC(IPRDEC+1)='VCTH'
  302. LESFAC(IPRDEC+2)='VCTB'
  303. LESFAC(IPRDEC+3)='VCT1'
  304. IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCT2'
  305. ENDIF
  306. 121 CONTINUE
  307.  
  308. ELSE
  309. DO 120 IPR=1,IDECAP
  310. IPRDEC = (IPR-1)*NCOVEC
  311. IF(IPR.EQ.1) THEN
  312. LESFAC(IPRDEC+1)='VCP1'
  313. LESFAC(IPRDEC+2)='VCP2'
  314. IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCP3'
  315. ELSE IF(IPR.EQ.2) THEN
  316. LESFAC(IPRDEC+1)='VCQ1'
  317. LESFAC(IPRDEC+2)='VCQ2'
  318. IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCQ3'
  319. ELSE IF(IPR.EQ.3) THEN
  320. LESFAC(IPRDEC+1)='VCT1'
  321. LESFAC(IPRDEC+2)='VCT2'
  322. IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCT3'
  323. ENDIF
  324. 120 CONTINUE
  325.  
  326. ENDIF
  327. *
  328. * RECUPERATION DES COMPOSANTES PRESENTES
  329. *
  330. NBTYPE=1
  331. SEGINI NOTYPE
  332. MOTYPE=NOTYPE
  333. TYPE(1)='REAL*8'
  334. CALL KOMCHA(IPCHM1,IPMAIL,CONM,MOVECO,MOTYPE,0,INFOS,3,IVAVCO)
  335. SEGSUP NOTYPE
  336. IF (IERR.NE.0) GOTO 9991
  337. *
  338. * ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  339. *
  340. MPTVAL = IVAVCO
  341. NCOSOU = IVAL(/1)
  342. DO 50 I=1,NCOSOU
  343. IF (IVAL(I).NE.0) GOTO 501
  344. 50 CONTINUE
  345. MOTERR(1:8)='VEC. COU'
  346. MOTERR(9:12)=NOMTP(MELE)
  347. MOTERR(13:20)='GNFL '
  348. CALL ERREUR(145)
  349. GO TO 9991
  350. 501 CONTINUE
  351. *
  352. * CHANGEMENT DE SUPPORT SI BESOIN
  353. *
  354. IF (ISUP1.EQ.1) THEN
  355. CALL VALCHE(IVAVCO,NVECO,IPMINT,IPPORE,MOVECO,MELE)
  356. IF (IERR.NE.0) THEN
  357. ISUP1 = 0
  358. GOTO 9991
  359. ENDIF
  360. ENDIF
  361. C____________________________________________________________________
  362. C
  363. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  364. C____________________________________________________________________
  365. *
  366. NCARA=0
  367. NCARF=0
  368.  
  369. IF (IPCHE2.NE.0) THEN
  370. NBROBL=0
  371. NBRFAC=0
  372. *
  373. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  374. *
  375. IF((MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59)
  376. + .AND.IFOUR.EQ.-2)THEN
  377. NBROBL=0
  378. NBRFAC=1
  379. SEGINI NOMID
  380. MOCARA=NOMID
  381. LESFAC(1)='DIM3'
  382. *
  383. NBTYPE=1
  384. SEGINI NOTYPE
  385. TYPE(1)='REAL*8'
  386. ENDIF
  387. NCARA=NBROBL
  388. NCARF=NBRFAC
  389. NCARR=NCARA+NCARF
  390. *
  391. IF (MOCARA.NE.0) THEN
  392. MOTYPE=NOTYPE
  393. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  394. $ IVACAR)
  395. SEGSUP NOTYPE
  396. IF (IERR.NE.0) GOTO 9991
  397. *
  398. IF (ISUP2.EQ.1) THEN
  399. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  400. IF (IERR.NE.0) THEN
  401. ISUP2=0
  402. GOTO 9991
  403. ENDIF
  404. ENDIF
  405. ENDIF
  406. ENDIF
  407. C
  408. C TAILLES DE MELVAL
  409. C
  410. N1EL =NBELEM
  411. N1PTEL=NBNN
  412. N2PTEL=0
  413. N2EL=0
  414. NBPTEL=NBPGAU
  415. NEL =N1EL
  416. C
  417. C CREATION DU MELVAL DE FORCES NODALES
  418. C
  419. NS=1
  420. NCOSOU=NCOMP
  421. SEGINI MPTVAL
  422. IVAFOR=MPTVAL
  423. DO 100 ICOMP=1,NCOSOU
  424. SEGINI MELVAL
  425. IELVAL(ICOMP)=MELVAL
  426. IVAL(ICOMP)=MELVAL
  427. 100 CONTINUE
  428. C
  429. IF(MELE.GE.79.AND.MELE.LE.83) GO TO 4
  430. IF(MELE.GE.173.AND.MELE.LE.182) GO TO 4
  431. IF(MELE.GE.108.AND.MELE.LE.110) GO TO 4
  432. IF(MELE.GE.185.AND.MELE.LE.190) GO TO 4
  433. C
  434. 99 CONTINUE
  435. MOTERR(1:4)=NOMTP(MELE)
  436. MOTERR(5:8)='GNFL'
  437. CALL ERREUR(86)
  438. GOTO 9991
  439. C_______________________________________________________________________
  440. C
  441. C poreux
  442. C_______________________________________________________________________
  443. C
  444. 4 CONTINUE
  445. CALL GNFL1(IPMAIL,NVECO,NBPGAU,MELE,MFR,IVAVCO,IPMINT,IVACAR,
  446. & IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP)
  447. GOTO 510
  448. C_______________________________________________________________________
  449. C
  450. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  451. C_______________________________________________________________________
  452. 510 CONTINUE
  453. C
  454. 9991 CONTINUE
  455. SEGDES MINTE
  456. SEGDES MCHAML
  457. 9990 CONTINUE
  458. SEGDES MELEME
  459. C
  460. IF (ISUP1.EQ.1)THEN
  461. CALL DTMVAL(IVAVCO,3)
  462. ELSE
  463. CALL DTMVAL(IVAVCO,1)
  464. ENDIF
  465. IF (MOVECO.NE.0) THEN
  466. NOMID=MOVECO
  467. SEGSUP NOMID
  468. ENDIF
  469. C
  470. CALL DTMVAL(IVAFOR,1)
  471. IF (MOFORC.NE.0) THEN
  472. NOMID=MOFORC
  473. if (lsupfo) SEGSUP NOMID
  474. ENDIF
  475. C
  476. IF (IPCHE2.NE.0) THEN
  477. IF (ISUP2.EQ.1) THEN
  478. CALL DTMVAL(IVACAR,3)
  479. ELSE
  480. CALL DTMVAL(IVACAR,1)
  481. ENDIF
  482. IF (MOCARA.NE.0) THEN
  483. NOMID=MOCARA
  484. SEGSUP NOMID
  485. ENDIF
  486. ENDIF
  487. C
  488. IF (IERR.NE.0) GO TO 9999
  489. C
  490. 200 CONTINUE
  491.  
  492. C_______________________________________________________________________
  493. C
  494. C TRANSFORMATION DU CHAMELEM EN CHPOINT
  495. C_______________________________________________________________________
  496. C
  497. CALL CHAMPO(IPCHE5,0,IPCHP4,IRET)
  498. IF (IERR.NE.0) GOTO 9999
  499. CALL DTCHAM(IPCHE5)
  500. C
  501. IRET = 1
  502. GOTO 9900
  503. C
  504. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  505. 9999 CONTINUE
  506. IRET = 0
  507. IPCHP4 = 0
  508. IF (IPCHE5.NE.0) SEGSUP,MCHELM
  509.  
  510. C- Fin du sous-programme : gestion des segments
  511. 9900 CONTINUE
  512. C Desactivation du modele
  513. DO ISOUS = 1, NSOUS
  514. IMODEL=KMODEL(ISOUS)
  515. SEGDES,IMODEL
  516. ENDDO
  517. SEGDES,MMODEL
  518. C Destructions de segments si necessaire
  519. IF (IPCHE1.EQ.0) CALL DTCHAM(IPCHM1)
  520.  
  521. RETURN
  522. END
  523.  
  524.  
  525.  

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