Télécharger zerop.eso

Retour à la liste

Numérotation des lignes :

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

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