Télécharger cneqp.eso

Retour à la liste

Numérotation des lignes :

  1. C CNEQP SOURCE PV 17/10/03 21:15:13 9581
  2.  
  3. SUBROUTINE CNEQP(IPMODL,IPCHE1,IPCHPO,IPCHE2, IPCHP4,IRET)
  4.  
  5. C_______________________________________________________________________
  6. C
  7. C Entrees:
  8. C ________
  9. C
  10. C IPMODL Pointeur sur un MMODEL
  11. C IPCHE1 Pointeur sur un MCHAML de forces volumiques
  12. C IPCHPO Pointeur sur un CHPOINT de forces volumiques
  13. C IPCHE2 Pointeur sur un MCHAML de caracteristiques (FACULTATIF)
  14. C
  15. C SORTIES:
  16. C ________
  17. C
  18. C IPCHP4 Pointeur sur un CHPOINT de forces aux noeuds
  19. C IRET =1 OU 0 suivant succes ou pas (Message d'erreur
  20. C imprime dans ce cas
  21. C
  22. C_______________________________________________________________________
  23. C
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. *
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC SMCHAML
  30. -INC SMCHPOI
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMMODEL
  34. -INC SMINTE
  35. *
  36. SEGMENT INFO
  37. INTEGER INFELL(JG)
  38. ENDSEGMENT
  39. *
  40. POINTEUR NOMID1.NOMID
  41. *
  42. SEGMENT NOTYPE
  43. CHARACTER*16 TYPE(NBTYPE)
  44. ENDSEGMENT
  45. *
  46. SEGMENT MPTVAL
  47. INTEGER IPOS(NS) ,NSOF(NS)
  48. INTEGER IVAL(NCOSOU)
  49. CHARACTER*16 TYVAL(NCOSOU)
  50. ENDSEGMENT
  51. *
  52. PARAMETER ( NINF=3 )
  53. INTEGER INFOS(NINF)
  54. CHARACTER*8 CMATE
  55. CHARACTER*(NCONCH) CONM
  56. LOGICAL lsupfo
  57. *
  58. IRET = 0
  59. IPCHP4 = 0
  60. *
  61. * Premieres verifications sur le modele (formulation)
  62. MMODEL = IPMODL
  63. SEGACT,MMODEL
  64. NSOUS = KMODEL(/1)
  65. IMECA = 0
  66. IELEC = 0
  67. IMAGN = 0
  68. DO ISOUS = 1, NSOUS
  69. IMODEL = KMODEL(ISOUS)
  70. SEGACT,IMODEL
  71. NFOR = FORMOD(/2)
  72. IF (NFOR.EQ.1) THEN
  73. IF (FORMOD(1).EQ.'MECANIQUE' .OR. FORMOD(1).EQ.'POREUX') THEN
  74. IMECA = 1
  75. ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  76. IELEC = 1
  77. ELSE IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  78. IMAGN = 1
  79. ELSE
  80. MOTERR(1:8) = FORMOD(1)
  81. CALL ERREUR(193)
  82. GOTO 9991
  83. ENDIF
  84. ELSE IF (NFOR.GT.1) THEN
  85. MOTERR(1:8) = FORMOD(1)
  86. CALL ERREUR(193)
  87. GOTO 9991
  88. ENDIF
  89. ENDDO
  90. IF (IMECA+IELEC+IMAGN .NE. 1) THEN
  91. *AV Affiner l'erreur !
  92. write(ioimp,*) 'Une seule formulation dans le modele !'
  93. CALL ERREUR(21)
  94. GOTO 9990
  95. ENDIF
  96. *
  97. * PASSAGE DU CHPOINT EN MCHAML
  98. *
  99. IF (IPCHE1.EQ.0) THEN
  100. CALL CHAME1(0,IPMODL,IPCHPO,'VOLUMIQUE',IPCHE1,1)
  101. ENDIF
  102. *
  103. * Verification du lieu support du MCHAML de forces volumiques
  104. *
  105. CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP1,IRET1)
  106. IF (ISUP1.GT.1) THEN
  107. CALL ERREUR(609)
  108. GOTO 9990
  109. ENDIF
  110. *
  111. * Verification du lieu support du MCHAML de caracteristiques
  112. *
  113. IF (IPCHE2.NE.0) THEN
  114. CALL QUESUP(IPMODL,IPCHE2,3,1,ISUP2,IRET2)
  115. IF (ISUP2.GT.1) THEN
  116. CALL ERREUR(609)
  117. GOTO 9990
  118. ENDIF
  119. ENDIF
  120. *_______________________________________________________________________
  121. *
  122. * ACTIVATION DU MODELE
  123. *_______________________________________________________________________
  124. *
  125. MMODEL=IPMODL
  126. SEGACT,MMODEL
  127. NSOUS=KMODEL(/1)
  128. C
  129. C ACTIVATION DU CHAMP VOLUMIQUE
  130. C
  131. MCHEL1=IPCHE1
  132. SEGACT MCHEL1
  133. C
  134. C INITIALISATION DU MCHELM DE VALEURS NODALES
  135. C
  136. L1=6
  137. N1=NSOUS
  138. N3=5
  139. SEGINI MCHELM
  140. IPCHE5=MCHELM
  141. IFOCHE=IFOUR
  142. TITCHE='FORCES'
  143. C Initialisation de quelques variables (MECANIQUE ou POREUX)
  144. IF (IMECA.EQ.1) THEN
  145. IF (IFOUR.EQ.-3) THEN
  146. NFORDG=3
  147. ELSE IF (IFOUR.EQ.11) THEN
  148. NFORDG=2
  149. ELSE IF ((IFOUR.GE.7.AND.IFOUR.LE.10).OR.IFOUR.EQ.14) THEN
  150. NFORDG=1
  151. ELSE
  152. NFORDG=0
  153. ENDIF
  154. ELSE
  155. NFORDG=0
  156. ENDIF
  157. C_______________________________________________________________________
  158. C
  159. C BOUCLE SUR LES SOUS ZONES
  160. C_______________________________________________________________________
  161. C
  162. DO 200 ISOUS=1,NSOUS
  163. C
  164. C INITIALISATION
  165. C
  166. IPMINT = 0
  167. IVACAR = 0
  168. IVAFOR = 0
  169. IVAFVO = 0
  170. MOCARA = 0
  171. MOFORC = 0
  172. MOFOVO = 0
  173. lsupfo=.true.
  174. MCHAML = 0
  175. C
  176. C TRAITEMENT DU MODELE
  177. C
  178. IMODEL=KMODEL(ISOUS)
  179. SEGACT IMODEL
  180. IIPDPG = imodel.IPDPGE
  181. IIPDPG = IPTPOI(IIPDPG)
  182. MELE=NEFMOD
  183. IPMAIL=IMAMOD
  184. CONM =CONMOD
  185. C____________________________________________________________________
  186. C
  187. C ACTIVATION DU MELEME
  188. C
  189. MELEME=IPMAIL
  190. SEGACT MELEME
  191. NBNN=NUM(/1)
  192. NBELEM=NUM(/2)
  193. C
  194. C CREATION DU TABLEAU INFOS
  195. C
  196. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  197. IF (IRTD.EQ.0) GOTO 510
  198. C_______________________________________________________________________
  199. C
  200. C INFORMATIONS SUR L'ELEMENT FINI
  201. C_______________________________________________________________________
  202. C
  203. iplaz=3
  204. C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') iplaz=2
  205. IF (IMAGN .EQ. 1) iplaz=2
  206. if(infmod(/1).lt.2+iplaz) then
  207. CALL ELQUOI(MELE,0,iplaz,IPINF,IMODEL)
  208. IF (IERR.NE.0) GOTO 510
  209. INFO=IPINF
  210. NBPGAU= INFELL(4)
  211. NBG = INFELL(6)
  212. MINTE = INFELL(11)
  213. MFR = INFELL(13)
  214. LW = INFELL(7)
  215. NDDL = INFELL(15)
  216. LRE = INFELL(9)
  217. IPORE = INFELL(8)
  218. MINTE1=INFELL(12)
  219. SEGSUP,INFO
  220. ELSE
  221. NBPGAU= INFELE(4)
  222. NBG = INFELE(6)
  223. minte=infmod(2+iplaz)
  224. MINTE1= INFMOD(8)
  225. MFR = INFELE(13)
  226. LW = INFELE(7)
  227. NDDL = INFELE(15)
  228. LRE = INFELE(9)
  229. IPORE = INFELE(8)
  230. ENDIF
  231. IPPORE=0
  232. IF(MFR.EQ.33) IPPORE=NBNN
  233. NHRM = NIFOUR
  234. C
  235. IPMINT = MINTE
  236. IPMIN1 = MINTE1
  237. SEGACT MINTE
  238. NBNO=SHPTOT(/2)
  239. C
  240. C RECOPIE DU MCHELM
  241. C
  242. IMACHE(ISOUS)=IPMAIL
  243. CONCHE(ISOUS)=CONMOD
  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. C_______________________________________________________________________
  250. C
  251. C NOMS DE COMPOSANTES EN SORTIE ( FORCES POUR L'INSTANT ,
  252. C COMPTE TENU DES FORMULATIONS DISPONIBLES )
  253. C + CREATION DU MCHAML
  254. C_______________________________________________________________________
  255. C
  256. C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  257. IF (IMAGN .EQ. 1) THEN
  258. CALL IDPVIN(MFR,IFOUR,MOFORC,NFOR,NFAC)
  259. IF ( NFAC.NE.0 ) THEN
  260. CALL ERREUR(19)
  261. GO TO 510
  262. ENDIF
  263. NCOMP=NFOR
  264. NOMID1=MOFORC
  265. SEGACT NOMID1
  266. N2=1
  267. SEGINI MCHAML
  268. ICHAML(ISOUS)=MCHAML
  269. NOMCHE(1)='ED'
  270. TYPCHE(1)='REAL*8'
  271. ELSE
  272. if(lnomid(2).ne.0) then
  273. moforc=lnomid(2)
  274. nomid1=moforc
  275. segact nomid1
  276. nfor=nomid1.lesobl(/2)
  277. nfac=nomid1.lesfac(/2)
  278. lsupfo=.false.
  279. else
  280. CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC)
  281. NOMID1=MOFORC
  282. SEGACT,NOMID1
  283. endif
  284. IF (NFAC.NE.0 .OR. NFOR.NE.NDDL) THEN
  285. SEGDES,NOMID1
  286. CALL ERREUR(19)
  287. GO TO 510
  288. ENDIF
  289. NCOMP=NFOR-NFORDG
  290. NDDL =NDDL-NFORDG
  291. N2=NCOMP
  292. SEGINI,MCHAML
  293. ICHAML(ISOUS)=MCHAML
  294. DO 110 ICOMP=1,NCOMP
  295. NOMCHE(ICOMP)=NOMID1.LESOBL(ICOMP)
  296. TYPCHE(ICOMP)='REAL*8'
  297. 110 CONTINUE
  298. ENDIF
  299. *_______________________________________________________________________
  300. *
  301. * TRAITEMENT DU CHAMP DE VALEURS NODALES EN ENTREE
  302. *_______________________________________________________________________
  303. *
  304. * ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  305. * MAIS ON LES MET EN FACULTATIF
  306. * PUIS ON CREE LE SEGMENT MOFOVO
  307. *
  308. NBROBL=0
  309. NBRFAC=NCOMP
  310. NFOVO=NBRFAC
  311. SEGINI NOMID
  312. MOFOVO=NOMID
  313. DO 120 ICOMP=1,NCOMP
  314. LESFAC(ICOMP)=NOMID1.LESOBL(ICOMP)
  315. 120 CONTINUE
  316. SEGDES NOMID
  317. SEGDES NOMID1
  318. *
  319. * RECUPERATION DES COMPOSANTES PRESENTES
  320. *
  321. NBTYPE=1
  322. SEGINI NOTYPE
  323. MOTYPE=NOTYPE
  324. TYPE(1)='REAL*8'
  325. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOFOVO,MOTYPE,0,INFOS,3,IVAFVO)
  326. SEGSUP NOTYPE
  327. IF (IERR.NE.0) GOTO 510
  328. *
  329. * ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  330. *
  331. MPTVAL = IVAFVO
  332. NCOSOU = IVAL(/1)
  333. NFOVOL = 0
  334. DO 50 I=1,NCOSOU
  335. IF (IVAL(I).NE.0) NFOVOL=NFOVOL+1
  336. 50 CONTINUE
  337. IF(NFOVOL.EQ.0) THEN
  338. MOTERR(1:8)='FOR. VOL'
  339. MOTERR(9:12)=NOMTP(MELE)
  340. MOTERR(13:20)='CNEQ '
  341. CALL ERREUR(145)
  342. GO TO 510
  343. ENDIF
  344. *
  345. * CHANGEMENT DE SUPPORT SI BESOIN
  346. *
  347. IF (ISUP1.EQ.1) THEN
  348. CALL VALCHE(IVAFVO,NFOVO,IPMINT,IPPORE,MOFOVO,MELE)
  349. ENDIF
  350. C____________________________________________________________________
  351. C
  352. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  353. C____________________________________________________________________
  354. *
  355. NBROBL=0
  356. NBRFAC=0
  357. NOMID =0
  358. IVECT=0
  359. *
  360. C* IF (FORMOD(1).NE.'MECANIQUE' .AND.
  361. C* & FORMOD(1).NE.'POREUX' ) GO TO 777
  362. IF (IMECA .NE. 1) GO TO 777
  363. *
  364. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  365. *
  366. IF((MFR.EQ.1.OR.MFR.EQ.33).AND.IFOUR.EQ.-2.
  367. + AND.IPCHE2.NE.0)THEN
  368. NBROBL=0
  369. NBRFAC=1
  370. SEGINI NOMID
  371. LESFAC(1)='DIM3'
  372. *
  373. NBTYPE=1
  374. SEGINI NOTYPE
  375. TYPE(1)='REAL*8'
  376. *
  377. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  378. *
  379. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  380. NBROBL=1
  381. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  382. NBRFAC=2
  383. ELSE
  384. NBRFAC=1
  385. ENDIF
  386. SEGINI NOMID
  387. LESOBL(1)='EPAI'
  388. LESFAC(1)='EXCE'
  389. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3'
  390. *
  391. NBTYPE=1
  392. SEGINI NOTYPE
  393. TYPE(1)='REAL*8'
  394. *
  395. * SECTION POUR LES BARRES
  396. *
  397. ELSE IF (MFR.EQ.27) THEN
  398. NBROBL=1
  399. SEGINI NOMID
  400. LESOBL(1)='SECT'
  401. *
  402. NBTYPE=1
  403. SEGINI NOTYPE
  404. TYPE(1)='REAL*8'
  405. *
  406. * CARACTERISTIQUES POUR LES POUTRES
  407. *
  408. ELSE IF (MFR.EQ.7 ) THEN
  409. NBROBL=4
  410. NBRFAC=3
  411. SEGINI NOMID
  412. LESOBL(1)='TORS'
  413. LESOBL(2)='INRY'
  414. LESOBL(3)='INRZ'
  415. LESOBL(4)='SECT'
  416. LESFAC(1)='SECY'
  417. LESFAC(2)='SECZ'
  418. LESFAC(3)='VECT'
  419. IVECT=1
  420. *
  421. NBTYPE=7
  422. SEGINI NOTYPE
  423. TYPE(1)='REAL*8'
  424. TYPE(2)='REAL*8'
  425. TYPE(3)='REAL*8'
  426. TYPE(4)='REAL*8'
  427. TYPE(5)='REAL*8'
  428. TYPE(6)='REAL*8'
  429. TYPE(7)='POINTEURPOINT '
  430. *
  431. * CARACTERISTIQUES POUR LES TUYAUX
  432. *
  433. ELSE IF (MFR.EQ.13) THEN
  434. NBROBL=2
  435. NBRFAC=2
  436. SEGINI NOMID
  437. LESOBL(1)='EPAI'
  438. LESOBL(2)='RAYO'
  439. LESFAC(1)='RACO'
  440. LESFAC(2)='VECT'
  441. IVECT=1
  442. C
  443. NBTYPE=4
  444. SEGINI NOTYPE
  445. TYPE(1)='REAL*8'
  446. TYPE(2)='REAL*8'
  447. TYPE(3)='REAL*8'
  448. TYPE(4)='POINTEURPOINT '
  449. *
  450. * CARACTERISTIQUES POUR LES LINESPRING
  451. *
  452. ELSE IF (MFR.EQ.15) THEN
  453. NBROBL=5
  454. SEGINI NOMID
  455. LESOBL(1)='EPAI'
  456. LESOBL(2)='FISS'
  457. LESOBL(3)='VX '
  458. LESOBL(4)='VY '
  459. LESOBL(5)='VZ '
  460. C
  461. NBTYPE=1
  462. SEGINI NOTYPE
  463. TYPE(1)='REAL*8'
  464. *
  465. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  466. *
  467. ELSE IF (MFR.EQ.17) THEN
  468. NBROBL=9
  469. SEGINI NOMID
  470. LESOBL(1)='RAYO'
  471. LESOBL(2)='EPAI'
  472. LESOBL(3)='VX '
  473. LESOBL(4)='VY '
  474. LESOBL(5)='VZ '
  475. LESOBL(6)='VXF '
  476. LESOBL(7)='VYF '
  477. LESOBL(8)='VZF '
  478. LESOBL(9)='ANGL'
  479. *
  480. NBTYPE=1
  481. SEGINI NOTYPE
  482. TYPE(1)='REAL*8'
  483. *
  484. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  485. *
  486. ELSE IF (MFR.EQ.37) THEN
  487. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  488. NBROBL=4
  489. SEGINI NOMID
  490. LESOBL(1)='SCEL'
  491. LESOBL(2)='SFLU'
  492. LESOBL(3)='EPS '
  493. LESOBL(4)='XINE'
  494. ELSE
  495. NBROBL=3
  496. SEGINI NOMID
  497. LESOBL(1)='SCEL'
  498. LESOBL(2)='SFLU'
  499. LESOBL(3)='EPS '
  500. ENDIF
  501. *
  502. NBTYPE=1
  503. SEGINI NOTYPE
  504. TYPE(1)='REAL*8'
  505. ENDIF
  506. *
  507. MOCARA=NOMID
  508. NCARA=NBROBL
  509. NCARF=NBRFAC
  510. NCARR=NCARA+NCARF
  511. *
  512. IF (MOCARA.NE.0) THEN
  513. IF (IPCHE2.EQ.0) THEN
  514. SEGSUP NOTYPE
  515. MOTERR(1:8)='CARACTER'
  516. MOTERR(9:12)=NOMTP(MELE)
  517. MOTERR(13:20)='CNEQ '
  518. CALL ERREUR(145)
  519. GOTO 510
  520. ENDIF
  521. MOTYPE=NOTYPE
  522. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  523. $ IVACAR)
  524. SEGSUP NOTYPE
  525. IF (IERR.NE.0) GOTO 510
  526. IF (IVECT.EQ.1) THEN
  527. MPTVAL=IVACAR
  528. IF (IVAL(NCARR).EQ.0) THEN
  529. *
  530. * MOT CLE VECT EN CAS DE CONVERSION
  531. *
  532. IVECT=2
  533. NBRFAC=NBRFAC+2
  534. SEGADJ NOMID
  535. LESFAC(NBRFAC-2)='VX '
  536. LESFAC(NBRFAC-1)='VY '
  537. LESFAC(NBRFAC )='VZ '
  538. NCARF=NBRFAC
  539. NCARR=NCARA+NCARF
  540. *
  541. NBTYPE=1
  542. SEGINI NOTYPE
  543. TYPE(1)='REAL*8'
  544. MOTYPE=NOTYPE
  545. C
  546. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  547. $ IVACAR)
  548. SEGSUP NOTYPE
  549. IF (IERR.NE.0)GOTO 510
  550. ENDIF
  551. ENDIF
  552. *
  553. IF (ISUP2.EQ.1) THEN
  554. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  555. IF (IERR.NE.0)THEN
  556. ISUP2=0
  557. GOTO 510
  558. ENDIF
  559. ENDIF
  560. ENDIF
  561. C
  562. C TAILLES DE MELVAL
  563. C
  564. 777 CONTINUE
  565. C
  566. N1EL =NBELEM
  567. N1PTEL=NBNN
  568. N2PTEL=0
  569. N2EL=0
  570. NBPTEL=NBPGAU
  571. NEL =N1EL
  572. C
  573. C CREATION DU MELVAL DE FORCES NODALES
  574. C
  575. NS=1
  576. C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  577. IF (IMAGN .EQ. 1) THEN
  578. NCOSOU=1
  579. ELSE
  580. NCOSOU=NCOMP
  581. ENDIF
  582. SEGINI MPTVAL
  583. IVAFOR=MPTVAL
  584. DO 100 ICOMP=1,NCOSOU
  585. SEGINI MELVAL
  586. IELVAL(ICOMP)=MELVAL
  587. IVAL(ICOMP)=MELVAL
  588. 100 CONTINUE
  589. C_______________________________________________________________________
  590. C
  591. C NUMERO DES ETIQUETTES :
  592. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  593. C Les elements sont groupes comme suit :
  594. C - massif, poreux ---------------------------------> CNEQ1
  595. C - coq3,dkt,coq4,coq8,coq2 ------------------------> CNEQ2
  596. C - poutre,tuyau,linespring,tuyau fissure,barre ----> CNEQ3
  597. C_______________________________________________________________________
  598. C
  599. IF(MELE.EQ.128) GO TO 128
  600. GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  601. 1 99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99,
  602. 2 27,29,29,27,99,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
  603. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 4, 4,
  604. 4 4, 4, 4,99,99,99,99,99,99,99,99,99,27,99,99,99,99),MELE
  605. C
  606. IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  607. 99 CONTINUE
  608. MOTERR(1:4)=NOMTP(MELE)
  609. MOTERR(5:8)='CNEQ'
  610. CALL ERREUR(86)
  611. GOTO 510
  612. C_______________________________________________________________________
  613. C
  614. C massifs, poreux
  615. C_______________________________________________________________________
  616. C
  617. 4 CONTINUE
  618. IF (MFR.EQ.71) THEN
  619. CALL CNEQEL(IPMAIL,IVAFVO,IPMINT,NBPGAU,IVAFOR,NCOMP)
  620. ELSE
  621. CALL CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT,IVACAR,
  622. & IPORE,NCOMP,IVAFOR,IIPDPG)
  623. ENDIF
  624. GOTO 510
  625. C_______________________________________________________________________
  626. C
  627. C coq3,dkt,coq4,coq8,coq2,dst
  628. C_______________________________________________________________________
  629. C
  630. 27 CONTINUE
  631. CALL CNEQ2(IPMAIL,LRE,NDDL,IVAFVO,LW,NBPGAU,IVACAR,CMATE,
  632. & NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,IMAT,IVAFOR)
  633. GOTO 510
  634. C_______________________________________________________________________
  635. C
  636. C poutre,tuyau,linespring,tuyau fissure,barre
  637. C_______________________________________________________________________
  638. C
  639. 29 CONTINUE
  640. GO TO 99
  641. C CAS NON PREVU
  642. C CALL CNEQ3(IPMAIL,LRE,NFOVO,LW,IVACAR,NCARR,IVECT,MELE,
  643. C & IVAFVO,ISOUS,NBPGAU,NBPTEL,IPMINT,NCOMP,IVAFOR)
  644. C GOTO 510
  645. C_______________________________________________________________________
  646. C
  647. C Element fini rot3 pour la magnetodynamique
  648. C_______________________________________________________________________
  649. C
  650. 128 CONTINUE
  651. CALL CNEQMG(IPMAIL,IPMINT,IVAFVO,IVAFOR,MOFOVO,MELE)
  652. GO TO 510
  653. C_______________________________________________________________________
  654. C
  655. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  656. C_______________________________________________________________________
  657. C
  658. 510 CONTINUE
  659. C
  660. SEGDES MELEME
  661. IF (IPMINT.NE.0) SEGDES MINTE
  662. C
  663. IF(ISUP1.EQ.1)THEN
  664. CALL DTMVAL(IVAFVO,3)
  665. ELSE
  666. CALL DTMVAL(IVAFVO,1)
  667. ENDIF
  668. C
  669. IF(ISUP2.EQ.1)THEN
  670. CALL DTMVAL(IVACAR,3)
  671. ELSE
  672. CALL DTMVAL(IVACAR,1)
  673. ENDIF
  674. C
  675. NOMID=MOFORC
  676. if(lsupfo.AND.MOFORC.NE.0) SEGSUP NOMID
  677. NOMID=MOFOVO
  678. IF (MOFOVO.NE.0) SEGSUP NOMID
  679. NOMID=MOCARA
  680. IF (MOCARA.NE.0) SEGSUP NOMID
  681. C
  682. IF (IERR.EQ.0) THEN
  683. CALL DTMVAL(IVAFOR,1)
  684. SEGDES MCHAML
  685. ELSE
  686. CALL DTMVAL(IVAFOR,3)
  687. IF (MCHAML.NE.0) SEGSUP MCHAML
  688. SEGSUP MCHELM
  689. IRET = 0
  690. GO TO 9990
  691. ENDIF
  692. C
  693. 200 CONTINUE
  694.  
  695. C_______________________________________________________________________
  696. C
  697. C TRANSFORMATION DU CHAMELEM EN CHPOINT
  698. C_______________________________________________________________________
  699. C
  700. IRET = 1
  701. CALL CHAMPO(IPCHE5,0,IPCHP4,IRET)
  702. CALL DTCHAM(IPCHE5)
  703. C
  704. C Desactivation (modele,mchaml) dans tous les cas
  705. 9990 CONTINUE
  706. SEGDES,MCHEL1
  707. 9991 CONTINUE
  708. DO ISOUS = 1, NSOUS
  709. IMODEL = KMODEL(ISOUS)
  710. SEGDES,IMODEL
  711. ENDDO
  712. SEGDES,MMODEL
  713.  
  714. RETURN
  715. END
  716.  
  717.  
  718.  

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