Télécharger zerop.eso

Retour à la liste

Numérotation des lignes :

  1. C ZEROP SOURCE CB215821 19/11/22 21:15:25 10387
  2.  
  3. C_______________________________________________________________________
  4. C
  5. C OPERATEUR MCHAML A ZERO
  6. C
  7. C Entrees:
  8. C ________
  9. C
  10. C IPMODL Pointeur sur un MMODEL
  11. C MOT Mot indiquant le type du MCHAML a creer
  12. C
  13. C Sorties:
  14. C ________
  15. C
  16. C IPCHEL Pointeur sur un MCHAML resultat a ZERO
  17. C
  18. C Passage aux nouveaux chamelems par i.monnier le 30.8.90
  19. C
  20. C_______________________________________________________________________
  21.  
  22. SUBROUTINE ZEROP(IPMODL,MOT,IPCHEL)
  23.  
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC CCOPTIO
  28.  
  29. -INC SMMODEL
  30. -INC SMCHAML
  31. -INC SMLREEL
  32.  
  33. SEGMENT info
  34. INTEGER infell(JG)
  35. ENDSEGMENT
  36.  
  37. ** pile modeles elementaires
  38. SEGMENT limode(nsmod)
  39.  
  40. CHARACTER*(*) MOT
  41.  
  42. PARAMETER (NMOT=24)
  43. CHARACTER*8 LISMOT(NMOT)
  44. CHARACTER*50 LISTIT(NMOT)
  45. DIMENSION MSUPPO(NMOT)
  46.  
  47. CHARACTER*8 CMATE
  48. LOGICAL lsupre
  49.  
  50. EXTERNAL LONG
  51.  
  52. DATA LISMOT / 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ',
  53. & 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL',
  54. & 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  55. & 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  56. & 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  57. & 'GRAFLEXI', 'VONMISES', 'VIMISTRU', 'DEFINELA'/
  58. *
  59. * 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ',
  60. DATA MSUPPO / 1 , 2 , 3 , 4 ,
  61. * 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL',
  62. & 5 , 1 , 1 , 1 ,
  63. * 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  64. & 3 , 5 , 5 , 5 ,
  65. * 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  66. & 3 , 3 , 5 , 5 ,
  67. * 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  68. & 3 , 5 , 5 , 5 ,
  69. * 'GRAFLEXI', 'VONMISES', 'VIMISTRU', 'DEFINELA'/
  70. & 5 , 5 , 1 , 5/
  71. *
  72. DATA LISTIT / 'NOEUD', 'GRAVITE', 'RIGIDITE', 'MASSE',
  73. & 'STRESSES', 'DEPLACEMENTS', 'FORCES',
  74. & 'REACTUALISATION', 'FORCES VOLUMIQUES',
  75. & 'GRADIENT', 'CONTRAINTES', 'DEFORMATIONS',
  76. & 'CARACTERISTIQUES', 'CARACTERISTIQUES',
  77. & 'TEMPERATURES', 'CONTRAINTES PRINCIPALES',
  78. & 'MATRICE DE HOOKE', 'MATRICE DE HOOKE TANGENTE',
  79. & 'DILATATIONS', 'VARIABLES INTERNES',
  80. & 'GRADIENT DE FLEXION','VON MISES',
  81. & 'VARIABLES INTERNES MICROSTRUCTURES',
  82. & 'DEFORMATIONS INELASTIQUES'/
  83.  
  84. IPCHEL = 0
  85. *
  86. * Verification que le sous-type du champ demande est prevu :
  87. *
  88. IPLAC = 0
  89. CALL PLACE(LISMOT,NMOT,IPLAC,MOT)
  90. IF (IPLAC.EQ.0) THEN
  91. CALL ERREUR(78)
  92. RETURN
  93. ENDIF
  94. *
  95. NHRM = NIFOUR
  96. *
  97. * Analyse du modele :
  98. *
  99. MMODEL = IPMODL
  100. NSOUS = mmodel.KMODEL(/1)
  101. *
  102. nvim = 0
  103. nsmod = 100
  104. SEGINI,limode
  105. DO is = 1, NSOUS
  106. imodel = mmodel.kmodel(is)
  107. imod_1 = 0
  108. C On determine si le sous-modele est a conserver
  109. C avec traitement des cas particuliers
  110. IF (imodel.nefmod.NE.22) THEN
  111. IF (imodel.formod(1).eq.'MELANGE') THEN
  112. IF (imodel.matmod(1).EQ.'PARALLELE') then
  113. SEGINI,imode1 = imodel
  114. imodel = imode1
  115. MN3 = imodel.infmod(/1)
  116. NFOR = imodel.formod(/2)
  117. NOBMOD = imodel.ivamod(/1)
  118. NMAT = 2
  119. SEGADJ,imodel
  120. imodel.formod(1) = 'MECANIQUE'
  121. imodel.matmod(1) = 'ELASTIQUE'
  122. imodel.matmod(2) = 'ISOTROPE'
  123. C On met le sous-modele en (<0) pour le detruire en fin de traitement :
  124. imod_1 = -imodel
  125. ELSE
  126. imod_1 = imodel
  127. ENDIF
  128. ELSE
  129. IF (formod(1).NE.'LIAISON') THEN
  130. imod_1 = imodel
  131. ENDIF
  132. ENDIF
  133. ENDIF
  134. c On conserve le sous-modele :
  135. IF (imod_1.NE.0) THEN
  136. IF (nvim .EQ. nsmod) THEN
  137. nsmod = nsmod + 100
  138. SEGADJ,limode
  139. ENDIF
  140. nvim = nvim + 1
  141. limode(nvim) = imod_1
  142. c On desactive le sous-modele non conserve :
  143. ELSE
  144. ENDIF
  145. ENDDO
  146.  
  147.  
  148. * IF (nvim.LE.0) THEN
  149. * CALL ERREUR(26)
  150. * GOTO 900
  151. * ENDIF
  152.  
  153. C-----------------------------------------------------------------------
  154. C CREATION DU MCHELM
  155. C-----------------------------------------------------------------------
  156. N1 = nvim
  157. L1 = LONG(LISTIT(IPLAC))
  158. N3 = 6
  159. ISUPPO = MSUPPO(IPLAC)
  160.  
  161. SEGINI,MCHELM
  162.  
  163. mchelm.TITCHE = LISTIT(IPLAC)(1:L1)
  164. mchelm.IFOCHE = IFOUR
  165.  
  166. C-----------------------------------------------------------------------
  167. C BOUCLE SUR LES SOUS-MODELES
  168. C-----------------------------------------------------------------------
  169. NZ = 0
  170.  
  171. DO 100 is = 1, nvim
  172.  
  173. IMODEL = ABS(limode(is))
  174.  
  175. C IPMAIL = imodel.IMAMOD
  176. MELE = imodel.NEFMOD
  177. IF (imodel.INFMOD(/1).NE.0) THEN
  178. NPINT = imodel.INFMOD(1)
  179. ELSE
  180. NPINT = 0
  181. ENDIF
  182. MFR = NUMMFR(MELE)
  183. CMATE = imodel.CMATEE
  184. C MATE = imodel.IMATEE
  185. INATU = imodel.INATUU
  186.  
  187. * AIGUILLAGE SUIVANT MOT CLE
  188. *
  189. MOCOMP = 0
  190. lsupre = .true.
  191. *
  192. GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2,
  193. & 99,20,21,99,23,24) IPLAC
  194. *
  195. 99 CONTINUE
  196. GOTO 120
  197. *
  198. 1 NBROBL = 1
  199. NBRFAC = 0
  200. SEGINI,nomid
  201. nomid.LESOBL(1) = 'SCAL'
  202. MOCOMP = nomid
  203. GOTO 120
  204. *
  205. 2 NBROBL = 1
  206. NBRFAC = 0
  207. SEGINI,nomid
  208. nomid.LESOBL(1) = 'MAHO'
  209. MOCOMP = nomid
  210. GOTO 120
  211. *
  212. 6 IF (imodel.lnomid(1).NE.0) THEN
  213. MOCOMP = imodel.lnomid(1)
  214. lsupre = .false.
  215. ELSE
  216. CALL IDPRIM(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  217. ENDIF
  218. GOTO 120
  219. *
  220. 7 IF (imodel.lnomid(2).NE.0) THEN
  221. MOCOMP = imodel.lnomid(2)
  222. lsupre = .false.
  223. ELSE
  224. CALL IDDUAL(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  225. ENDIF
  226. GOTO 120
  227. *
  228. 10 IF (imodel.lnomid(3).NE.0) THEN
  229. MOCOMP = imodel.lnomid(3)
  230. lsupre = .false.
  231. ELSE
  232. CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  233. ENDIF
  234. GOTO 120
  235. *
  236. 11 IF (imodel.lnomid(4).NE.0) THEN
  237. MOCOMP = imodel.lnomid(4)
  238. lsupre = .false.
  239. ELSE
  240. CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  241. ENDIF
  242. GOTO 120
  243. *
  244. 12 IF (imodel.lnomid(5).NE.0) THEN
  245. MOCOMP = imodel.lnomid(5)
  246. lsupre = .false.
  247. ELSE
  248. CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  249. ENDIF
  250. GOTO 120
  251. *
  252. 13 IF (imodel.lnomid(6).NE.0) THEN
  253. MOCOMP = imodel.lnomid(6)
  254. lsupre = .false.
  255. ELSE
  256. CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  257. ENDIF
  258. GOTO 120
  259. *
  260. 14 IF (imodel.lnomid(7).NE.0) THEN
  261. MOCOMP = imodel.lnomid(7)
  262. lsupre = .false.
  263. ELSE
  264. CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
  265. ENDIF
  266. GOTO 120
  267. *
  268. 15 IF (imodel.lnomid(8).NE.0) THEN
  269. MOCOMP = imodel.lnomid(8)
  270. lsupre = .false.
  271. ELSE
  272. CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
  273. ENDIF
  274. GOTO 120
  275. *
  276. 16 IF (imodel.lnomid(9).NE.0) THEN
  277. MOCOMP = imodel.lnomid(9)
  278. lsupre = .false.
  279. ELSE
  280. CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  281. ENDIF
  282. GOTO 120
  283. *
  284. 20 IF (imodel.lnomid(10).NE.0) THEN
  285. MOCOMP = imodel.lnomid(10)
  286. lsupre = .false.
  287. ELSE
  288. CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  289. ENDIF
  290. GOTO 120
  291. *
  292. 21 IF (imodel.lnomid(11).NE.0) THEN
  293. MOCOMP = imodel.lnomid(11)
  294. lsupre = .false.
  295. ELSE
  296. CALL IDGRAF(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  297. ENDIF
  298. GOTO 120
  299. *
  300. 23 IF (imodel.lnomid(12).NE.0) THEN
  301. MOCOMP = imodel.lnomid(12)
  302. lsupre = .false.
  303. ELSE
  304. CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  305. ENDIF
  306. GOTO 120
  307. *
  308. 24 IF (imodel.lnomid(13).NE.0) THEN
  309. MOCOMP = imodel.lnomid(13)
  310. lsupre = .false.
  311. ELSE
  312. CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  313. ENDIF
  314. GOTO 120
  315. *
  316. 120 CONTINUE
  317. C Pas de composantes a traiter pour le sous-modele :
  318. IF (MOCOMP.EQ.0) GOTO 100
  319. nomid = MOCOMP
  320. SEGACT,nomid
  321. NOBL = nomid.LESOBL(/2)
  322. NFAC = nomid.LESFAC(/2)
  323. N2 = NOBL + NFAC
  324. IF (N2.EQ.0) GOTO 110
  325.  
  326. C Recuperation d'informations sur le support :
  327. C Traitement des cas particuliers :
  328. NFORQ = FORMOD(/2)
  329. CALL PLACE(FORMOD,NFORQ,icont,'CONTACT ')
  330. CALL PLACE(FORMOD,NFORQ,ither,'THERMIQUE ')
  331. CALL PLACE(FORMOD,NFORQ,idiff,'DIFFUSION ')
  332. CALL PLACE(FORMOD,NFORQ,imeta,'METALLURGIE ')
  333. CALL PLACE(FORMOD,NFORQ,ichph,'CHANGEMENT_PHASE')
  334. IF (icont.NE.0 .OR. ichph.NE.0)THEN
  335. C Pour le contact, on met aux noeuds d'office :
  336. ISUPMO = 1
  337. MINTE = 0
  338. NSTRS = 0
  339.  
  340. ELSEIF(ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  341. C Support GRAVITE indisponible ==> aux NOEUDS
  342. IF (ISUPPO .LE. 2) ISUPMO = 1
  343.  
  344. nmat = imodel.matmod(/2)
  345. CALL PLACE(imodel.matmod,nmat,iplr,'RAYONNEMENT')
  346. C Support 6 SAUF pour le RAYONNEMENT...
  347. C Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  348. IF (iplr.eq.0) THEN
  349. ISUPMO = 6
  350. CALL TSHAPE(MELE,'GAUSS',MINTE)
  351. ELSE
  352. ISUPMO = ISUPPO
  353. NLG = NUMGEO(MELE)
  354. CALL TSHAPE(NLG,'GAUSS',MINTE)
  355. ENDIF
  356. NSTRS = 0
  357.  
  358. ELSE
  359. C Pour les autres formulations :
  360. ISUPMO = ISUPPO
  361. IF (imodel.infmod(/1).LT.2+ISUPMO) THEN
  362. CALL ELQUOI(MELE,0,ISUPMO,ipinf,imodel)
  363. IF (IERR.NE.0) GOTO 900
  364. info = ipinf
  365. MINTE = info.infell(11)
  366. NSTRS = info.infell(16)
  367. SEGSUP,info
  368. ELSE
  369. MINTE = imodel.INFMOD(2+ISUPMO)
  370. NSTRS = imodel.INFELE(16)
  371. ENDIF
  372. ENDIF
  373. C
  374. SEGINI,MCHAML
  375. C
  376. IF (NOBL.EQ.0) GOTO 130
  377. DO io = 1, NOBL
  378. mchaml.NOMCHE(io) = nomid.LESOBL(io)
  379. N1PTEL = 0
  380. N1EL = 0
  381. N2PTEL = 0
  382. N2EL = 0
  383. IF (IPLAC.EQ.17.OR.IPLAC.EQ.18) THEN
  384. mchaml.TYPCHE(io) = 'POINTEURLISTREEL'
  385. N2PTEL = 1
  386. N2EL = 1
  387. SEGINI,MELVAL
  388. JG = 1
  389. SEGINI,MLREEL
  390. melval.IELCHE(1,1) = MLREEL
  391. ELSE IF (IPLAC.EQ.20.AND.CMATE.EQ.'SECTION')THEN
  392. mchaml.TYPCHE(io) = 'POINTEURMCHAML '
  393. N2PTEL = 1
  394. N2EL = 1
  395. SEGINI,MELVAL
  396. melval.IELCHE(1,1) = 0
  397. *
  398. * MODELE DE MAXWELL - COMPOSANTES AUTRES QUE EPSE
  399. ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.74.AND.io.GT.1) THEN
  400. mchaml.TYPCHE(IO) = 'POINTEURLISTREEL'
  401. N2PTEL = 1
  402. N2EL = 1
  403. SEGINI,MELVAL
  404. JG = NSTRS
  405. SEGINI,MLREEL
  406. melval.IELCHE(1,1) = MLREEL
  407. *
  408. * MODELE MAXOTT COMPOSANTE AUTRES QUE REAL*8
  409. ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.106) THEN
  410. IF ((IFOUR.EQ.2.AND.MFR.EQ.1)
  411. & .AND. io.GT.21) THEN
  412. mlreel = 1
  413. ELSE IF ((IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
  414. & IFOUR.EQ.0 .OR.IFOUR.EQ.1)
  415. & .AND. io.GT.16) THEN
  416. mlreel = 1
  417. ELSE IF ((IFOUR.EQ.-2.OR.
  418. & (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)))
  419. & .AND. io.GT.13) THEN
  420. mlreel = 1
  421. ELSE
  422. mlreel = 0
  423. ENDIF
  424. IF (mlreel .EQ. 0) THEN
  425. mchaml.TYPCHE(io) = 'REAL*8'
  426. N1PTEL = 1
  427. N1EL = 1
  428. SEGINI,MELVAL
  429. ELSE
  430. mchaml.TYPCHE(io) = 'POINTEURLISTREEL'
  431. N2PTEL = 1
  432. N2EL = 1
  433. SEGINI,MELVAL
  434. JG = NSTRS
  435. SEGINI,MLREEL
  436. melval.IELCHE(1,1) = MLREEL
  437. ENDIF
  438. ELSE
  439. mchaml.TYPCHE(io) = 'REAL*8'
  440. N1PTEL = 1
  441. N1EL = 1
  442. SEGINI,MELVAL
  443. ENDIF
  444. mchaml.IELVAL(io) = MELVAL
  445. ENDDO
  446. 130 CONTINUE
  447.  
  448. IF (NFAC.EQ.0) GOTO 140
  449. DO io = 1, NFAC
  450. mchaml.NOMCHE(io+NOBL) = nomid.LESFAC(io)
  451. N1PTEL = 0
  452. N1EL = 0
  453. N2PTEL = 0
  454. N2EL = 0
  455.  
  456. * MODELE MAXOTT - SUITE
  457. IF (INATU.EQ.106) THEN
  458. mchaml.TYPCHE(io+NOBL) = 'POINTEURLISTREEL'
  459. N2PTEL = 1
  460. N2EL = 1
  461. SEGINI,MELVAL
  462. JG = NSTRS
  463. SEGINI,MLREEL
  464. melval.IELCHE(1,1) = MLREEL
  465. *
  466. * MODELE DE MAXWELL - SUITE
  467. ELSE IF (INATU.EQ.74) THEN
  468. mchaml.TYPCHE(io+NOBL) = 'POINTEURLISTREEL'
  469. N2PTEL = 1
  470. N2EL = 1
  471. SEGINI,MELVAL
  472. JG = NSTRS
  473. SEGINI,MLREEL
  474. melval.IELCHE(1,1) = MLREEL
  475. ELSE
  476. mchaml.TYPCHE(io+NOBL) = 'REAL*8'
  477. N1PTEL = 1
  478. N1EL = 1
  479. SEGINI,MELVAL
  480. ENDIF
  481. mchaml.IELVAL(io+NOBL) = MELVAL
  482. ENDDO
  483. 140 CONTINUE
  484. C
  485. IF (IPLAC.EQ.11 .OR. IPLAC.EQ.20) THEN
  486. IF (CMATE.EQ.'MODAL' .OR. CMATE.EQ.'STATIQUE') THEN
  487. N2 = 1
  488. SEGADJ,MCHAML
  489. ENDIF
  490. ENDIF
  491. C
  492. NZ = NZ + 1
  493. mchelm.IMACHE(NZ) = imodel.IMAMOD
  494. mchelm.CONCHE(NZ) = imodel.CONMOD
  495. mchelm.ICHAML(NZ) = MCHAML
  496. mchelm.INFCHE(NZ,1) = 0
  497. mchelm.INFCHE(NZ,2) = 0
  498. mchelm.INFCHE(NZ,3) = NHRM
  499. mchelm.INFCHE(NZ,4) = MINTE
  500. mchelm.INFCHE(NZ,5) = 0
  501. mchelm.INFCHE(NZ,6) = ISUPMO
  502.  
  503. 110 CONTINUE
  504. nomid = MOCOMP
  505. IF (lsupre) THEN
  506. SEGSUP,nomid
  507. ENDIF
  508.  
  509. 100 CONTINUE
  510. C-----------------------------------------------------------------------
  511. C Fin de la boucle sur les SOUS-MODELES retenus
  512. C-----------------------------------------------------------------------
  513. IF (NZ.NE.nvim) THEN
  514. N1 = NZ
  515. SEGADJ,MCHELM
  516. ENDIF
  517. IPCHEL = MCHELM
  518.  
  519. 900 CONTINUE
  520.  
  521. DO is = 1, nvim
  522. imodel = limode(is)
  523. IF (imodel.LT.0) THEN
  524. imodel = ABS(imodel)
  525. SEGSUP,imodel
  526. ENDIF
  527. ENDDO
  528. SEGSUP,limode
  529.  
  530. END
  531.  
  532.  
  533.  
  534.  

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