Télécharger cneqp.eso

Retour à la liste

Numérotation des lignes :

  1. C CNEQP SOURCE PASCAL 16/09/15 21:15:01 9090
  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=IPDPGE
  181. MELE=NEFMOD
  182. IPMAIL=IMAMOD
  183. CONM =CONMOD
  184. C____________________________________________________________________
  185. C
  186. C ACTIVATION DU MELEME
  187. C
  188. MELEME=IPMAIL
  189. SEGACT MELEME
  190. NBNN=NUM(/1)
  191. NBELEM=NUM(/2)
  192. C
  193. C CREATION DU TABLEAU INFOS
  194. C
  195. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  196. IF (IRTD.EQ.0) GOTO 510
  197. C_______________________________________________________________________
  198. C
  199. C INFORMATIONS SUR L'ELEMENT FINI
  200. C_______________________________________________________________________
  201. C
  202. iplaz=3
  203. C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') iplaz=2
  204. IF (IMAGN .EQ. 1) iplaz=2
  205. if(infmod(/1).lt.2+iplaz) then
  206. CALL ELQUOI(MELE,0,iplaz,IPINF,IMODEL)
  207. IF (IERR.NE.0) GOTO 510
  208. INFO=IPINF
  209. NBPGAU= INFELL(4)
  210. NBG = INFELL(6)
  211. MINTE = INFELL(11)
  212. MFR = INFELL(13)
  213. LW = INFELL(7)
  214. NDDL = INFELL(15)
  215. LRE = INFELL(9)
  216. IPORE = INFELL(8)
  217. MINTE1=INFELL(12)
  218. SEGSUP,INFO
  219. ELSE
  220. NBPGAU= INFELE(4)
  221. NBG = INFELE(6)
  222. minte=infmod(2+iplaz)
  223. MINTE1= INFMOD(8)
  224. MFR = INFELE(13)
  225. LW = INFELE(7)
  226. NDDL = INFELE(15)
  227. LRE = INFELE(9)
  228. IPORE = INFELE(8)
  229. ENDIF
  230. IPPORE=0
  231. IF(MFR.EQ.33) IPPORE=NBNN
  232. NHRM = NIFOUR
  233. C
  234. IPMINT = MINTE
  235. IPMIN1 = MINTE1
  236. SEGACT MINTE
  237. NBNO=SHPTOT(/2)
  238. C
  239. C RECOPIE DU MCHELM
  240. C
  241. IMACHE(ISOUS)=IPMAIL
  242. CONCHE(ISOUS)=CONMOD
  243. INFCHE(ISOUS,1)=0
  244. INFCHE(ISOUS,2)=0
  245. INFCHE(ISOUS,3)=NIFOUR
  246. INFCHE(ISOUS,4)=0
  247. INFCHE(ISOUS,5)=0
  248. C_______________________________________________________________________
  249. C
  250. C NOMS DE COMPOSANTES EN SORTIE ( FORCES POUR L'INSTANT ,
  251. C COMPTE TENU DES FORMULATIONS DISPONIBLES )
  252. C + CREATION DU MCHAML
  253. C_______________________________________________________________________
  254. C
  255. C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  256. IF (IMAGN .EQ. 1) THEN
  257. CALL IDPVIN(MFR,IFOUR,MOFORC,NFOR,NFAC)
  258. IF ( NFAC.NE.0 ) THEN
  259. CALL ERREUR(19)
  260. GO TO 510
  261. ENDIF
  262. NCOMP=NFOR
  263. NOMID1=MOFORC
  264. SEGACT NOMID1
  265. N2=1
  266. SEGINI MCHAML
  267. ICHAML(ISOUS)=MCHAML
  268. NOMCHE(1)='ED'
  269. TYPCHE(1)='REAL*8'
  270. ELSE
  271. if(lnomid(2).ne.0) then
  272. moforc=lnomid(2)
  273. nomid1=moforc
  274. segact nomid1
  275. nfor=nomid1.lesobl(/2)
  276. nfac=nomid1.lesfac(/2)
  277. lsupfo=.false.
  278. else
  279. CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC)
  280. NOMID1=MOFORC
  281. SEGACT,NOMID1
  282. endif
  283. IF (NFAC.NE.0 .OR. NFOR.NE.NDDL) THEN
  284. SEGDES,NOMID1
  285. CALL ERREUR(19)
  286. GO TO 510
  287. ENDIF
  288. NCOMP=NFOR-NFORDG
  289. NDDL =NDDL-NFORDG
  290. N2=NCOMP
  291. SEGINI,MCHAML
  292. ICHAML(ISOUS)=MCHAML
  293. DO 110 ICOMP=1,NCOMP
  294. NOMCHE(ICOMP)=NOMID1.LESOBL(ICOMP)
  295. TYPCHE(ICOMP)='REAL*8'
  296. 110 CONTINUE
  297. ENDIF
  298. *_______________________________________________________________________
  299. *
  300. * TRAITEMENT DU CHAMP DE VALEURS NODALES EN ENTREE
  301. *_______________________________________________________________________
  302. *
  303. * ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  304. * MAIS ON LES MET EN FACULTATIF
  305. * PUIS ON CREE LE SEGMENT MOFOVO
  306. *
  307. NBROBL=0
  308. NBRFAC=NCOMP
  309. NFOVO=NBRFAC
  310. SEGINI NOMID
  311. MOFOVO=NOMID
  312. DO 120 ICOMP=1,NCOMP
  313. LESFAC(ICOMP)=NOMID1.LESOBL(ICOMP)
  314. 120 CONTINUE
  315. SEGDES NOMID
  316. SEGDES NOMID1
  317. *
  318. * RECUPERATION DES COMPOSANTES PRESENTES
  319. *
  320. NBTYPE=1
  321. SEGINI NOTYPE
  322. MOTYPE=NOTYPE
  323. TYPE(1)='REAL*8'
  324. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOFOVO,MOTYPE,0,INFOS,3,IVAFVO)
  325. SEGSUP NOTYPE
  326. IF (IERR.NE.0) GOTO 510
  327. *
  328. * ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  329. *
  330. MPTVAL = IVAFVO
  331. NCOSOU = IVAL(/1)
  332. NFOVOL = 0
  333. DO 50 I=1,NCOSOU
  334. IF (IVAL(I).NE.0) NFOVOL=NFOVOL+1
  335. 50 CONTINUE
  336. IF(NFOVOL.EQ.0) THEN
  337. MOTERR(1:8)='FOR. VOL'
  338. MOTERR(9:12)=NOMTP(MELE)
  339. MOTERR(13:20)='CNEQ '
  340. CALL ERREUR(145)
  341. GO TO 510
  342. ENDIF
  343. *
  344. * CHANGEMENT DE SUPPORT SI BESOIN
  345. *
  346. IF (ISUP1.EQ.1) THEN
  347. CALL VALCHE(IVAFVO,NFOVO,IPMINT,IPPORE,MOFOVO,MELE)
  348. ENDIF
  349. C____________________________________________________________________
  350. C
  351. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  352. C____________________________________________________________________
  353. *
  354. NBROBL=0
  355. NBRFAC=0
  356. NOMID =0
  357. IVECT=0
  358. *
  359. C* IF (FORMOD(1).NE.'MECANIQUE' .AND.
  360. C* & FORMOD(1).NE.'POREUX' ) GO TO 777
  361. IF (IMECA .NE. 1) GO TO 777
  362. *
  363. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  364. *
  365. IF((MFR.EQ.1.OR.MFR.EQ.33).AND.IFOUR.EQ.-2.
  366. + AND.IPCHE2.NE.0)THEN
  367. NBROBL=0
  368. NBRFAC=1
  369. SEGINI NOMID
  370. LESFAC(1)='DIM3'
  371. *
  372. NBTYPE=1
  373. SEGINI NOTYPE
  374. TYPE(1)='REAL*8'
  375. *
  376. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  377. *
  378. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  379. NBROBL=1
  380. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  381. NBRFAC=2
  382. ELSE
  383. NBRFAC=1
  384. ENDIF
  385. SEGINI NOMID
  386. LESOBL(1)='EPAI'
  387. LESFAC(1)='EXCE'
  388. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3'
  389. *
  390. NBTYPE=1
  391. SEGINI NOTYPE
  392. TYPE(1)='REAL*8'
  393. *
  394. * SECTION POUR LES BARRES
  395. *
  396. ELSE IF (MFR.EQ.27) THEN
  397. NBROBL=1
  398. SEGINI NOMID
  399. LESOBL(1)='SECT'
  400. *
  401. NBTYPE=1
  402. SEGINI NOTYPE
  403. TYPE(1)='REAL*8'
  404. *
  405. * CARACTERISTIQUES POUR LES POUTRES
  406. *
  407. ELSE IF (MFR.EQ.7 ) THEN
  408. NBROBL=4
  409. NBRFAC=3
  410. SEGINI NOMID
  411. LESOBL(1)='TORS'
  412. LESOBL(2)='INRY'
  413. LESOBL(3)='INRZ'
  414. LESOBL(4)='SECT'
  415. LESFAC(1)='SECY'
  416. LESFAC(2)='SECZ'
  417. LESFAC(3)='VECT'
  418. IVECT=1
  419. *
  420. NBTYPE=7
  421. SEGINI NOTYPE
  422. TYPE(1)='REAL*8'
  423. TYPE(2)='REAL*8'
  424. TYPE(3)='REAL*8'
  425. TYPE(4)='REAL*8'
  426. TYPE(5)='REAL*8'
  427. TYPE(6)='REAL*8'
  428. TYPE(7)='POINTEURPOINT '
  429. *
  430. * CARACTERISTIQUES POUR LES TUYAUX
  431. *
  432. ELSE IF (MFR.EQ.13) THEN
  433. NBROBL=2
  434. NBRFAC=2
  435. SEGINI NOMID
  436. LESOBL(1)='EPAI'
  437. LESOBL(2)='RAYO'
  438. LESFAC(1)='RACO'
  439. LESFAC(2)='VECT'
  440. IVECT=1
  441. C
  442. NBTYPE=4
  443. SEGINI NOTYPE
  444. TYPE(1)='REAL*8'
  445. TYPE(2)='REAL*8'
  446. TYPE(3)='REAL*8'
  447. TYPE(4)='POINTEURPOINT '
  448. *
  449. * CARACTERISTIQUES POUR LES LINESPRING
  450. *
  451. ELSE IF (MFR.EQ.15) THEN
  452. NBROBL=5
  453. SEGINI NOMID
  454. LESOBL(1)='EPAI'
  455. LESOBL(2)='FISS'
  456. LESOBL(3)='VX '
  457. LESOBL(4)='VY '
  458. LESOBL(5)='VZ '
  459. C
  460. NBTYPE=1
  461. SEGINI NOTYPE
  462. TYPE(1)='REAL*8'
  463. *
  464. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  465. *
  466. ELSE IF (MFR.EQ.17) THEN
  467. NBROBL=9
  468. SEGINI NOMID
  469. LESOBL(1)='RAYO'
  470. LESOBL(2)='EPAI'
  471. LESOBL(3)='VX '
  472. LESOBL(4)='VY '
  473. LESOBL(5)='VZ '
  474. LESOBL(6)='VXF '
  475. LESOBL(7)='VYF '
  476. LESOBL(8)='VZF '
  477. LESOBL(9)='ANGL'
  478. *
  479. NBTYPE=1
  480. SEGINI NOTYPE
  481. TYPE(1)='REAL*8'
  482. *
  483. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  484. *
  485. ELSE IF (MFR.EQ.37) THEN
  486. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  487. NBROBL=4
  488. SEGINI NOMID
  489. LESOBL(1)='SCEL'
  490. LESOBL(2)='SFLU'
  491. LESOBL(3)='EPS '
  492. LESOBL(4)='XINE'
  493. ELSE
  494. NBROBL=3
  495. SEGINI NOMID
  496. LESOBL(1)='SCEL'
  497. LESOBL(2)='SFLU'
  498. LESOBL(3)='EPS '
  499. ENDIF
  500. *
  501. NBTYPE=1
  502. SEGINI NOTYPE
  503. TYPE(1)='REAL*8'
  504. ENDIF
  505. *
  506. MOCARA=NOMID
  507. NCARA=NBROBL
  508. NCARF=NBRFAC
  509. NCARR=NCARA+NCARF
  510. *
  511. IF (MOCARA.NE.0) THEN
  512. IF (IPCHE2.EQ.0) THEN
  513. SEGSUP NOTYPE
  514. MOTERR(1:8)='CARACTER'
  515. MOTERR(9:12)=NOMTP(MELE)
  516. MOTERR(13:20)='CNEQ '
  517. CALL ERREUR(145)
  518. GOTO 510
  519. ENDIF
  520. MOTYPE=NOTYPE
  521. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  522. $ IVACAR)
  523. SEGSUP NOTYPE
  524. IF (IERR.NE.0) GOTO 510
  525. IF (IVECT.EQ.1) THEN
  526. MPTVAL=IVACAR
  527. IF (IVAL(NCARR).EQ.0) THEN
  528. *
  529. * MOT CLE VECT EN CAS DE CONVERSION
  530. *
  531. IVECT=2
  532. NBRFAC=NBRFAC+2
  533. SEGADJ NOMID
  534. LESFAC(NBRFAC-2)='VX '
  535. LESFAC(NBRFAC-1)='VY '
  536. LESFAC(NBRFAC )='VZ '
  537. NCARF=NBRFAC
  538. NCARR=NCARA+NCARF
  539. *
  540. NBTYPE=1
  541. SEGINI NOTYPE
  542. TYPE(1)='REAL*8'
  543. MOTYPE=NOTYPE
  544. C
  545. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  546. $ IVACAR)
  547. SEGSUP NOTYPE
  548. IF (IERR.NE.0)GOTO 510
  549. ENDIF
  550. ENDIF
  551. *
  552. IF (ISUP2.EQ.1) THEN
  553. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  554. IF (IERR.NE.0)THEN
  555. ISUP2=0
  556. GOTO 510
  557. ENDIF
  558. ENDIF
  559. ENDIF
  560. C
  561. C TAILLES DE MELVAL
  562. C
  563. 777 CONTINUE
  564. C
  565. N1EL =NBELEM
  566. N1PTEL=NBNN
  567. N2PTEL=0
  568. N2EL=0
  569. NBPTEL=NBPGAU
  570. NEL =N1EL
  571. C
  572. C CREATION DU MELVAL DE FORCES NODALES
  573. C
  574. NS=1
  575. C* IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  576. IF (IMAGN .EQ. 1) THEN
  577. NCOSOU=1
  578. ELSE
  579. NCOSOU=NCOMP
  580. ENDIF
  581. SEGINI MPTVAL
  582. IVAFOR=MPTVAL
  583. DO 100 ICOMP=1,NCOSOU
  584. SEGINI MELVAL
  585. IELVAL(ICOMP)=MELVAL
  586. IVAL(ICOMP)=MELVAL
  587. 100 CONTINUE
  588. C_______________________________________________________________________
  589. C
  590. C NUMERO DES ETIQUETTES :
  591. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  592. C Les elements sont groupes comme suit :
  593. C - massif, poreux ---------------------------------> CNEQ1
  594. C - coq3,dkt,coq4,coq8,coq2 ------------------------> CNEQ2
  595. C - poutre,tuyau,linespring,tuyau fissure,barre ----> CNEQ3
  596. C_______________________________________________________________________
  597. C
  598. IF(MELE.EQ.128) GO TO 128
  599. GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  600. 1 99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99,
  601. 2 27,29,29,27,99,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
  602. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 4, 4,
  603. 4 4, 4, 4,99,99,99,99,99,99,99,99,99,27,99,99,99,99),MELE
  604. C
  605. IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  606. 99 CONTINUE
  607. MOTERR(1:4)=NOMTP(MELE)
  608. MOTERR(5:8)='CNEQ'
  609. CALL ERREUR(86)
  610. GOTO 510
  611. C_______________________________________________________________________
  612. C
  613. C massifs, poreux
  614. C_______________________________________________________________________
  615. C
  616. 4 CONTINUE
  617. IF (MFR.EQ.71) THEN
  618. CALL CNEQEL(IPMAIL,IVAFVO,IPMINT,NBPGAU,IVAFOR,NCOMP)
  619. ELSE
  620. CALL CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT,IVACAR,
  621. & IPORE,NCOMP,IVAFOR,IIPDPG)
  622. ENDIF
  623. GOTO 510
  624. C_______________________________________________________________________
  625. C
  626. C coq3,dkt,coq4,coq8,coq2,dst
  627. C_______________________________________________________________________
  628. C
  629. 27 CONTINUE
  630. CALL CNEQ2(IPMAIL,LRE,NDDL,IVAFVO,LW,NBPGAU,IVACAR,CMATE,
  631. & NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,IMAT,IVAFOR)
  632. GOTO 510
  633. C_______________________________________________________________________
  634. C
  635. C poutre,tuyau,linespring,tuyau fissure,barre
  636. C_______________________________________________________________________
  637. C
  638. 29 CONTINUE
  639. GO TO 99
  640. C CAS NON PREVU
  641. C CALL CNEQ3(IPMAIL,LRE,NFOVO,LW,IVACAR,NCARR,IVECT,MELE,
  642. C & IVAFVO,ISOUS,NBPGAU,NBPTEL,IPMINT,NCOMP,IVAFOR)
  643. C GOTO 510
  644. C_______________________________________________________________________
  645. C
  646. C Element fini rot3 pour la magnetodynamique
  647. C_______________________________________________________________________
  648. C
  649. 128 CONTINUE
  650. CALL CNEQMG(IPMAIL,IPMINT,IVAFVO,IVAFOR,MOFOVO,MELE)
  651. GO TO 510
  652. C_______________________________________________________________________
  653. C
  654. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  655. C_______________________________________________________________________
  656. C
  657. 510 CONTINUE
  658. C
  659. SEGDES MELEME
  660. IF (IPMINT.NE.0) SEGDES MINTE
  661. C
  662. IF(ISUP1.EQ.1)THEN
  663. CALL DTMVAL(IVAFVO,3)
  664. ELSE
  665. CALL DTMVAL(IVAFVO,1)
  666. ENDIF
  667. C
  668. IF(ISUP2.EQ.1)THEN
  669. CALL DTMVAL(IVACAR,3)
  670. ELSE
  671. CALL DTMVAL(IVACAR,1)
  672. ENDIF
  673. C
  674. NOMID=MOFORC
  675. if(lsupfo.AND.MOFORC.NE.0) SEGSUP NOMID
  676. NOMID=MOFOVO
  677. IF (MOFOVO.NE.0) SEGSUP NOMID
  678. NOMID=MOCARA
  679. IF (MOCARA.NE.0) SEGSUP NOMID
  680. C
  681. IF (IERR.EQ.0) THEN
  682. CALL DTMVAL(IVAFOR,1)
  683. SEGDES MCHAML
  684. ELSE
  685. CALL DTMVAL(IVAFOR,3)
  686. IF (MCHAML.NE.0) SEGSUP MCHAML
  687. SEGSUP MCHELM
  688. IRET = 0
  689. GO TO 9990
  690. ENDIF
  691. C
  692. 200 CONTINUE
  693.  
  694. C_______________________________________________________________________
  695. C
  696. C TRANSFORMATION DU CHAMELEM EN CHPOINT
  697. C_______________________________________________________________________
  698. C
  699. IRET = 1
  700. CALL CHAMPO(IPCHE5,0,IPCHP4,IRET)
  701. CALL DTCHAM(IPCHE5)
  702. C
  703. C Desactivation (modele,mchaml) dans tous les cas
  704. 9990 CONTINUE
  705. SEGDES,MCHEL1
  706. 9991 CONTINUE
  707. DO ISOUS = 1, NSOUS
  708. IMODEL = KMODEL(ISOUS)
  709. SEGDES,IMODEL
  710. ENDDO
  711. SEGDES,MMODEL
  712.  
  713. RETURN
  714. END
  715.  
  716.  
  717.  
  718.  
  719.  
  720.  
  721.  

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