Télécharger cneqp.eso

Retour à la liste

Numérotation des lignes :

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

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