Télécharger gnflp.eso

Retour à la liste

Numérotation des lignes :

  1. C GNFLP SOURCE AM 16/04/12 21:15:51 8903
  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=IPDPGE
  136. MELE=NEFMOD
  137. IPMAIL=IMAMOD
  138. CONM =CONMOD
  139. C____________________________________________________________________
  140. C
  141. C ACTIVATION DU MELEME
  142. C
  143. MELEME=IPMAIL
  144. SEGACT MELEME
  145. NBNN=NUM(/1)
  146. NBELEM=NUM(/2)
  147. C
  148. C CREATION DU TABLEAU INFOS
  149. C
  150. CALL IDENT(IPMAIL,CONM,IPCHM1,IPCHE2,INFOS,IRTD)
  151. IF (IRTD.EQ.0) GOTO 9990
  152. C_______________________________________________________________________
  153. C
  154. C INFORMATIONS SUR L'ELEMENT FINI
  155. C_______________________________________________________________________
  156. C
  157. if(infmod(/1).lt.5) then
  158. CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  159. IF (IERR.NE.0) GOTO 9990
  160. INFO=IPINF
  161. NBPGAU= INFELL(4)
  162. NBG = INFELL(6)
  163. MINTE = INFELL(11)
  164. MINTE1= INFELL(12)
  165. IPMINT= MINTE
  166. IPMIN1= MINTE1
  167. MFR = INFELL(13)
  168. LW = INFELL(7)
  169. IELE = INFELL(14)
  170. IPORE = INFELL(8)
  171. segsup info
  172. ELSE
  173. NBPGAU= INFELE(4)
  174. NBG = INFELE(6)
  175. * MINTE = INFELE(11)
  176. MINTE=INFMOD(5)
  177. MINTE1= INFMOD(8)
  178. IPMINT= MINTE
  179. IPMIN1= MINTE1
  180. MFR = INFELE(13)
  181. LW = INFELE(7)
  182. IELE = INFELE(14)
  183. IPORE = INFELE(8)
  184. ENDIF
  185. IPPORE=0
  186. IF(MFR.EQ.33) THEN
  187. IPPORE=NBNN
  188. IDECAP=1
  189. ELSE IF(MFR.EQ.57) THEN
  190. IPPORE=NBNN
  191. IDECAP=2
  192. ELSE IF(MFR.EQ.59) THEN
  193. IPPORE=NBNN
  194. IDECAP=3
  195. ENDIF
  196. NHRM = NIFOUR
  197. C
  198. SEGACT MINTE
  199. NBNO=SHPTOT(/2)
  200. C
  201. C RECOPIE DU MCHELM
  202. C
  203. IMACHE(ISOUS)=IPMAIL
  204. CONCHE(ISOUS)=CONMOD
  205. INFCHE(ISOUS,1)=0
  206. INFCHE(ISOUS,2)=0
  207. INFCHE(ISOUS,3)=NIFOUR
  208. INFCHE(ISOUS,4)=0
  209. INFCHE(ISOUS,5)=0
  210. C_______________________________________________________________________
  211. C
  212. C NOMS DE COMPOSANTES EN SORTIE
  213. C_______________________________________________________________________
  214. C
  215. if(lnomid(2).ne.0) then
  216. lsupfo=.false.
  217. moforc=lnomid(2)
  218. nomid=moforc
  219. segact nomid
  220. NFORC=lesobl(/2)
  221. nfac=lesfac(/2)
  222. else
  223. lsupfo=.true.
  224. CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NFAC)
  225. NOMID=MOFORC
  226. SEGACT NOMID
  227. endif
  228. NCOMP=IDECAP
  229. C
  230. C CREATION DU MCHAML
  231. C
  232. N2=NCOMP
  233. SEGINI MCHAML
  234. ICHAML(ISOUS)=MCHAML
  235. DO 110 ICOMP=1,NCOMP
  236. IPRDEC=NFORC-IDECAP+ICOMP
  237. NOMCHE(ICOMP)=LESOBL(IPRDEC)
  238. TYPCHE(ICOMP)='REAL*8'
  239. 110 CONTINUE
  240. *_______________________________________________________________________
  241. *
  242. * TRAITEMENT DU CHAMP DE VALEURS EN ENTREE
  243. *_______________________________________________________________________
  244. *
  245. * ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  246. * MAIS ON LES MET EN FACULTATIF
  247. *
  248. * CAS JOINTS
  249. *
  250. IF((MELE.GE.108.AND.MELE.LE.110).OR.
  251. . (MELE.GE.185.AND.MELE.LE.190)) THEN
  252.  
  253. IF(IFOUR.LE.0) THEN
  254. * CAS PLAN
  255. NCOVEC=3
  256. ELSE IF (IFOUR.EQ.2) THEN
  257. * 3D
  258. NCOVEC=4
  259. ENDIF
  260. ELSE
  261.  
  262. IF(IFOUR.LE.0) THEN
  263. * CONTRAINTES PLANES - DEFORMATIONS PLANES
  264. * DEFO PLAN GENE
  265. * AXISYMETRIQUE
  266. NCOVEC=2
  267.  
  268. ELSE IF (IFOUR.GT.0) THEN
  269. * FOURIER
  270. * 3D
  271. NCOVEC=3
  272. ENDIF
  273. ENDIF
  274. *
  275. * PUIS ON CREE LE SEGMENT MOVECO
  276. *
  277. NBROBL=0
  278. NBRFAC=NCOVEC*IDECAP
  279. *
  280. NVECO=NBRFAC
  281. SEGINI NOMID
  282. MOVECO=NOMID
  283.  
  284. IF((MELE.GE.108.AND.MELE.LE.110).OR.
  285. . (MELE.GE.185.AND.MELE.LE.190)) THEN
  286.  
  287. DO 121 IPR=1,IDECAP
  288. IPRDEC = (IPR-1)*NCOVEC
  289. IF(IPR.EQ.1) THEN
  290. LESFAC(IPRDEC+1)='VCPH'
  291. LESFAC(IPRDEC+2)='VCPB'
  292. LESFAC(IPRDEC+3)='VCP1'
  293. IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCP2'
  294. ELSE IF(IPR.EQ.2) THEN
  295. LESFAC(IPRDEC+1)='VCQH'
  296. LESFAC(IPRDEC+2)='VCQB'
  297. LESFAC(IPRDEC+3)='VCQ1'
  298. IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCQ2'
  299. ELSE IF(IPR.EQ.3) THEN
  300. LESFAC(IPRDEC+1)='VCTH'
  301. LESFAC(IPRDEC+2)='VCTB'
  302. LESFAC(IPRDEC+3)='VCT1'
  303. IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCT2'
  304. ENDIF
  305. 121 CONTINUE
  306.  
  307. ELSE
  308. DO 120 IPR=1,IDECAP
  309. IPRDEC = (IPR-1)*NCOVEC
  310. IF(IPR.EQ.1) THEN
  311. LESFAC(IPRDEC+1)='VCP1'
  312. LESFAC(IPRDEC+2)='VCP2'
  313. IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCP3'
  314. ELSE IF(IPR.EQ.2) THEN
  315. LESFAC(IPRDEC+1)='VCQ1'
  316. LESFAC(IPRDEC+2)='VCQ2'
  317. IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCQ3'
  318. ELSE IF(IPR.EQ.3) THEN
  319. LESFAC(IPRDEC+1)='VCT1'
  320. LESFAC(IPRDEC+2)='VCT2'
  321. IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCT3'
  322. ENDIF
  323. 120 CONTINUE
  324.  
  325. ENDIF
  326. *
  327. * RECUPERATION DES COMPOSANTES PRESENTES
  328. *
  329. NBTYPE=1
  330. SEGINI NOTYPE
  331. MOTYPE=NOTYPE
  332. TYPE(1)='REAL*8'
  333. CALL KOMCHA(IPCHM1,IPMAIL,CONM,MOVECO,MOTYPE,0,INFOS,3,IVAVCO)
  334. SEGSUP NOTYPE
  335. IF (IERR.NE.0) GOTO 9991
  336. *
  337. * ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  338. *
  339. MPTVAL = IVAVCO
  340. NCOSOU = IVAL(/1)
  341. DO 50 I=1,NCOSOU
  342. IF (IVAL(I).NE.0) GOTO 501
  343. 50 CONTINUE
  344. MOTERR(1:8)='VEC. COU'
  345. MOTERR(9:12)=NOMTP(MELE)
  346. MOTERR(13:20)='GNFL '
  347. CALL ERREUR(145)
  348. GO TO 9991
  349. 501 CONTINUE
  350. *
  351. * CHANGEMENT DE SUPPORT SI BESOIN
  352. *
  353. IF (ISUP1.EQ.1) THEN
  354. CALL VALCHE(IVAVCO,NVECO,IPMINT,IPPORE,MOVECO,MELE)
  355. IF (IERR.NE.0) THEN
  356. ISUP1 = 0
  357. GOTO 9991
  358. ENDIF
  359. ENDIF
  360. C____________________________________________________________________
  361. C
  362. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  363. C____________________________________________________________________
  364. *
  365. NCARA=0
  366. NCARF=0
  367.  
  368. IF (IPCHE2.NE.0) THEN
  369. NBROBL=0
  370. NBRFAC=0
  371. *
  372. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  373. *
  374. IF((MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59)
  375. + .AND.IFOUR.EQ.-2)THEN
  376. NBROBL=0
  377. NBRFAC=1
  378. SEGINI NOMID
  379. MOCARA=NOMID
  380. LESFAC(1)='DIM3'
  381. *
  382. NBTYPE=1
  383. SEGINI NOTYPE
  384. TYPE(1)='REAL*8'
  385. ENDIF
  386. NCARA=NBROBL
  387. NCARF=NBRFAC
  388. NCARR=NCARA+NCARF
  389. *
  390. IF (MOCARA.NE.0) THEN
  391. MOTYPE=NOTYPE
  392. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  393. $ IVACAR)
  394. SEGSUP NOTYPE
  395. IF (IERR.NE.0) GOTO 9991
  396. *
  397. IF (ISUP2.EQ.1) THEN
  398. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  399. IF (IERR.NE.0) THEN
  400. ISUP2=0
  401. GOTO 9991
  402. ENDIF
  403. ENDIF
  404. ENDIF
  405. ENDIF
  406. C
  407. C TAILLES DE MELVAL
  408. C
  409. N1EL =NBELEM
  410. N1PTEL=NBNN
  411. N2PTEL=0
  412. N2EL=0
  413. NBPTEL=NBPGAU
  414. NEL =N1EL
  415. C
  416. C CREATION DU MELVAL DE FORCES NODALES
  417. C
  418. NS=1
  419. NCOSOU=NCOMP
  420. SEGINI MPTVAL
  421. IVAFOR=MPTVAL
  422. DO 100 ICOMP=1,NCOSOU
  423. SEGINI MELVAL
  424. IELVAL(ICOMP)=MELVAL
  425. IVAL(ICOMP)=MELVAL
  426. 100 CONTINUE
  427. C
  428. IF(MELE.GE.79.AND.MELE.LE.83) GO TO 4
  429. IF(MELE.GE.173.AND.MELE.LE.182) GO TO 4
  430. IF(MELE.GE.108.AND.MELE.LE.110) GO TO 4
  431. IF(MELE.GE.185.AND.MELE.LE.190) GO TO 4
  432. C
  433. 99 CONTINUE
  434. MOTERR(1:4)=NOMTP(MELE)
  435. MOTERR(5:8)='GNFL'
  436. CALL ERREUR(86)
  437. GOTO 9991
  438. C_______________________________________________________________________
  439. C
  440. C poreux
  441. C_______________________________________________________________________
  442. C
  443. 4 CONTINUE
  444. CALL GNFL1(IPMAIL,NVECO,NBPGAU,MELE,MFR,IVAVCO,IPMINT,IVACAR,
  445. & IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP)
  446. GOTO 510
  447. C_______________________________________________________________________
  448. C
  449. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  450. C_______________________________________________________________________
  451. 510 CONTINUE
  452. C
  453. 9991 CONTINUE
  454. SEGDES MINTE
  455. SEGDES MCHAML
  456. 9990 CONTINUE
  457. SEGDES MELEME
  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 Desactivation du modele
  512. DO ISOUS = 1, NSOUS
  513. IMODEL=KMODEL(ISOUS)
  514. SEGDES,IMODEL
  515. ENDDO
  516. SEGDES,MMODEL
  517. C Destructions de segments si necessaire
  518. IF (IPCHE1.EQ.0) CALL DTCHAM(IPCHM1)
  519.  
  520. RETURN
  521. END
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  

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