Télécharger gnflp.eso

Retour à la liste

Numérotation des lignes :

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

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