Télécharger cneqp.eso

Retour à la liste

Numérotation des lignes :

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

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