Télécharger cneqp.eso

Retour à la liste

Numérotation des lignes :

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

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