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. -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. CALL ERREUR(19)
  289. GO TO 510
  290. ENDIF
  291. NCOMP=NFOR-NFORDG
  292. NDDL =NDDL-NFORDG
  293. N2=NCOMP
  294. SEGINI,MCHAML
  295. ICHAML(ISOUS)=MCHAML
  296. DO 110 ICOMP=1,NCOMP
  297. NOMCHE(ICOMP)=NOMID1.LESOBL(ICOMP)
  298. TYPCHE(ICOMP)='REAL*8'
  299. 110 CONTINUE
  300. ENDIF
  301. *_______________________________________________________________________
  302. *
  303. * TRAITEMENT DU CHAMP DE VALEURS NODALES EN ENTREE
  304. *_______________________________________________________________________
  305. *
  306. * ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  307. * MAIS ON LES MET EN FACULTATIF
  308. * PUIS ON CREE LE SEGMENT MOFOVO
  309. *
  310. NBROBL=0
  311. NBRFAC=NCOMP
  312. NFOVO=NBRFAC
  313. SEGINI NOMID
  314. MOFOVO=NOMID
  315. DO 120 ICOMP=1,NCOMP
  316. LESFAC(ICOMP)=NOMID1.LESOBL(ICOMP)
  317. 120 CONTINUE
  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. C
  661. IF(ISUP1.EQ.1)THEN
  662. CALL DTMVAL(IVAFVO,3)
  663. ELSE
  664. CALL DTMVAL(IVAFVO,1)
  665. ENDIF
  666. C
  667. IF(ISUP2.EQ.1)THEN
  668. CALL DTMVAL(IVACAR,3)
  669. ELSE
  670. CALL DTMVAL(IVACAR,1)
  671. ENDIF
  672. C
  673. NOMID=MOFORC
  674. if(lsupfo.AND.MOFORC.NE.0) SEGSUP NOMID
  675. NOMID=MOFOVO
  676. IF (MOFOVO.NE.0) SEGSUP NOMID
  677. NOMID=MOCARA
  678. IF (MOCARA.NE.0) SEGSUP NOMID
  679. C
  680. IF (IERR.EQ.0) THEN
  681. CALL DTMVAL(IVAFOR,1)
  682. ELSE
  683. CALL DTMVAL(IVAFOR,3)
  684. IF (MCHAML.NE.0) SEGSUP MCHAML
  685. SEGSUP MCHELM
  686. IRET = 0
  687. GO TO 9990
  688. ENDIF
  689. C
  690. 200 CONTINUE
  691.  
  692. C_______________________________________________________________________
  693. C
  694. C TRANSFORMATION DU CHAMELEM EN CHPOINT
  695. C_______________________________________________________________________
  696. C
  697. IRET = 1
  698. CALL CHAMPO(IPCHE5,0,IPCHP4,IRET)
  699. CALL DTCHAM(IPCHE5)
  700. C
  701. C Desactivation (modele,mchaml) dans tous les cas
  702. 9990 CONTINUE
  703. 9991 CONTINUE
  704. END
  705.  
  706.  
  707.  

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