Télécharger chame1.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAME1 SOURCE PV 20/04/03 21:15:13 10571
  2. SUBROUTINE CHAME1(IPMAIL,IPMODL,IPCHPO,CHA,IPCHEL,ISUP)
  3. C____________________________________________________________________*
  4. C *
  5. C transformation de CHPOINT en MCHAML *
  6. C *
  7. C entrees: *
  8. C ________ *
  9. C *
  10. C ipmail pointeur sur un maillage *
  11. C ou ipmodl pointeur sur un mmodel *
  12. C ipchpo pointeur sur le chpoint *
  13. C cha chaine de caractere contenant un sous type eventuel
  14. C isup indique le type de support demande : *
  15. C 1 le mchaml est laisse aux noeuds *
  16. C 2 au centre de gravite *
  17. C 3 aux points de gauss de la raideur *
  18. C 4 aux points de gauss de la masse *
  19. C 5 aux points de gauss des contraintes *
  20. C 6 aux point de gauss de la thermique & diffusion *
  21. C & metallurgie *
  22. C *
  23. C sorties: *
  24. C ________ *
  25. C *
  26. C ipchel pointeur sur le mchaml resultat *
  27. C *
  28. C Remarque : le passage du mchaml sur un autre support que les *
  29. C -------- noeuds n'est possible que si l'on a donne un mmodel *
  30. C *
  31. C le traitement d'harmoniques de fourier n'est pas *
  32. C implemente *
  33. C *
  34. C____________________________________________________________________*
  35. C *
  36. IMPLICIT INTEGER(I-N)
  37. IMPLICIT REAL*8(A-H,O-Z)
  38.  
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC CCGEOME
  43. -INC CCASSIS
  44.  
  45. -INC SMCHAML
  46. -INC SMCHPOI
  47. -INC SMINTE
  48. -INC SMMODEL
  49. -INC SMELEME
  50. -INC SMCOORD
  51.  
  52. COMMON/cham1c/IPARA1,IPARA2
  53. EXTERNAL CHA1i
  54. LOGICAL BTHRD
  55.  
  56. SEGMENT SPARA1
  57. INTEGER NBTHR1
  58. INTEGER IPCH1
  59. INTEGER IPTP1
  60. INTEGER IPTR1
  61. ENDSEGMENT
  62.  
  63. SEGMENT SPARA2
  64. INTEGER NBTHRD
  65. INTEGER IISUP
  66. INTEGER IPSAU
  67. INTEGER IPMOD
  68. INTEGER IPCHE
  69. INTEGER IPTPR
  70. INTEGER IPTRA
  71. ENDSEGMENT
  72.  
  73. SEGMENT INFO
  74. INTEGER INFELL(JG)
  75. ENDSEGMENT
  76.  
  77. SEGMENT ISAUT(IVAL,NSOUS)
  78. SEGMENT ICPR(nbpts)
  79.  
  80. SEGMENT MTRA2
  81. C Copie du CHPOINT dans MTRA2 pour aller plus vite ensuite
  82. CHARACTER*4 INCO(N2)
  83. REAL*8 BB(NX,N2)
  84. C INCO : Nom des INCONNUES du CHPOINT
  85. C BB : Valeurs au noeuds du MMODEL (associees au ICPR)
  86. C NX : Nombre de noeuds differents dans le MODELE
  87. C N2 : Nombre de composantes dans le CHPOINT
  88. ENDSEGMENT
  89.  
  90. CHARACTER*(*) CHA
  91. CHARACTER*4 MO4
  92. CHARACTER*1 MO1,VID1
  93.  
  94. C soutyp = sous-type du champ par element resultat
  95. C lsouty = longueur utile de la chaine "soutyp"
  96. C
  97. INTEGER LSOUTY
  98. CHARACTER*72 SOUTYP
  99. C
  100. EXTERNAL CHAM1I
  101. C
  102. IPARA1= 0
  103. IPARA2= 0
  104.  
  105. NT1 = 1
  106. NT2 = 1
  107. IOPTIM= 100
  108.  
  109. INFO = 0
  110. ISUP1 = ISUP
  111. IPCHEL= 0
  112. NPINT = 0
  113. VID1 =' '
  114.  
  115. ither = 0
  116. idiff = 0
  117. imeta = 0
  118.  
  119. C
  120. C on cree l'objet maillage contenant tous les points du chpoint
  121. C
  122. MCHPOI=IPCHPO
  123. NSOUPO=IPCHP(/1)
  124. C
  125. IF (IPMAIL.NE.0) THEN
  126. IPT1=IPMAIL
  127. NSOUS=IPT1.LISOUS(/1)
  128. IF (NSOUS.EQ.0) THEN
  129. NSOUS=1
  130. ENDIF
  131. ISUP1=1
  132. ELSE IF (IPMODL.NE.0) THEN
  133. MMODEL = IPMODL
  134. NSOUS = KMODEL(/1)
  135. ENDIF
  136. C
  137. C initialisation du segment descripteur du champ par element
  138. C
  139. N1=NSOUS
  140. N3=6
  141. MO1 = CHA(1:1)
  142. IF (MO1.EQ.VID1) THEN
  143. L1=8
  144. SOUTYP=MTYPOI
  145. ELSE
  146. L1=LEN(CHA)
  147. SOUTYP=CHA
  148. ENDIF
  149.  
  150. C Renvoi le nombre de composantes
  151. CALL NBCOMP(MCHPOI,'CHPOINT ',N2)
  152.  
  153. NX =0
  154. N2PTEL=0
  155. N2EL =0
  156. ISOUSs=0
  157.  
  158. C Dimensionnement de ISAUT
  159. IF(IPMODL .NE. 0)THEN
  160. IVAL=6
  161. ELSE
  162. IVAL=3
  163. ENDIF
  164.  
  165. IF(OOTHRD .NE.0) call oooprl(1)
  166. SEGINI,ICPR,ISAUT
  167. IF(OOTHRD .NE.0) call oooprl(0)
  168.  
  169. DO 19 ISOUS=1,NSOUS
  170. ISUP1 =ISUP
  171. IPMINT=0
  172. IF (IPMAIL.NE.0) THEN
  173. IF (NSOUS.GT.1) THEN
  174. IPT2=IPT1.LISOUS(ISOUS)
  175. ELSE
  176. IPT2=IPMAIL
  177. ENDIF
  178.  
  179. ELSEIF (IPMODL.NE.0) THEN
  180. IMODEL = KMODEL(ISOUS)
  181. c pour les elements MULT, on autorise que les MCHAML aux noeuds
  182. if(ISUP1.ne.1) then
  183. itest=nefmod
  184. if(itest.eq.22.OR.itest.eq.259) goto 19
  185. endif
  186. IPT2 = IMAMOD
  187.  
  188. if (formod(1)(1:8).eq.'LIAISON ') then
  189. C ne fait rien si le maillage de LIAISON n'appartient pas au CHPOINT
  190.  
  191. IVAL1 = IPT2.num(1,1)
  192. DO I=1,NSOUPO
  193. MSOUPO=IPCHP(I)
  194. MELEME=IGEOC
  195. do jno = 1, num(/2)
  196. if (num(1,jno).eq.IVAL1) goto 191
  197. enddo
  198. goto 19
  199. ENDDO
  200. endif
  201. 191 CONTINUE
  202.  
  203. IMODEL = KMODEL(ISOUS)
  204. IF(INFMOD(/1).NE.0) NPINT=INFMOD(1)
  205. C
  206. C Changment de support si besoin selon la formulation ?
  207. IF (ISUP1 .NE. 1) THEN
  208. NFOR = FORMOD(/2)
  209. CALL PLACE(FORMOD,NFOR,icont,'CONTACT ')
  210. CALL PLACE(FORMOD,NFOR,ichph,'CHANGEMENT_PHASE')
  211. IF (icont.NE.0 .OR. ichph.NE.0) THEN
  212. ISUP1 = 1
  213. ELSE
  214. CALL PLACE(FORMOD,NFOR,ither,'THERMIQUE')
  215. CALL PLACE(FORMOD,NFOR,idiff,'DIFFUSION')
  216. CALL PLACE(FORMOD,NFOR,imeta,'METALLURGIE')
  217. IF (ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  218. nmat = matmod(/2)
  219. CALL PLACE(matmod,nmat,iray,'RAYONNEMENT')
  220. C Support 6 SAUF pour le RAYONNEMENT...
  221. C Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  222. IF (iray.EQ.0) ISUP1 = 6
  223. ENDIF
  224. ENDIF
  225. ENDIF
  226. C
  227. C on recupere le pointeur sur le minte correspondant a isup1
  228. C
  229. IF (ISUP1.GT.1) THEN
  230. MELE=NEFMOD
  231. IF ( ISUP1 .EQ. 6) THEN
  232. C cas de la THERMIQUE(sauf RAYONNEMENT) OU DIFFUSION OU METALLURGIE
  233. CALL TSHAPE(MELE,'GAUSS',IPMINT)
  234. IF (IERR.NE.0) RETURN
  235. IELE = NUMGEO(MELE)
  236. NBNN = NBNNE(IELE)
  237. ELSE
  238. if(2+isup1.gt.infmod(/1)) then
  239. CALL ELQUOI(MELE,0,ISUP1,INFO,IMODEL)
  240. IF (IERR.NE.0) RETURN
  241. IPMINT=INFELL(11)
  242. else
  243. IPMINT=infmod(2+isup1)
  244. IELE =INFELE(14)
  245. NBNN =NBNNE(IELE)
  246. endif
  247. C write(6,*) ' chame1 ipmint iele nbnn',ipmint,iele,nbnn
  248. ENDIF
  249. C
  250. C initialisation de ipore pour milieu poreux
  251. C
  252. IPORE=0
  253. IF(MELE.GE.79 .AND.MELE.LE.83 ) IPORE=NBNN
  254. IF(MELE.GE.173.AND.MELE.LE.177) IPORE=NBNN
  255. IF(MELE.GE.178.AND.MELE.LE.182) IPORE=NBNN
  256. C cas XFEM il faut seulement les 4 premier noeuds (support geometrique)
  257. IF(MELE.GE.263) IPORE=NBNN
  258.  
  259. ISAUT(4,ISOUS)=IPMINT
  260. IF(IPORE .EQ. 0)THEN
  261. MINTE =IPMINT
  262. ISAUT(5,ISOUS)=SHPTOT(/2)
  263. ELSE
  264. ISAUT(5,ISOUS)=IPORE
  265. ENDIF
  266. ENDIF
  267.  
  268. ISAUT(6,ISOUS)= ISUP1
  269.  
  270. ELSE
  271. CALL ERREUR(5)
  272. RETURN
  273. ENDIF
  274.  
  275. ISOUSs=ISOUSs+1
  276.  
  277. ISAUT(1,ISOUS) = IPT2
  278.  
  279. NBNO = IPT2.NUM(/1)
  280. N1EL = IPT2.NUM(/2)
  281.  
  282. C Remplissage de l'ICPR a partir des noeuds du MMODEL
  283. C L'utilisation d'un ICPR par MMODEL limite l'utilisation de
  284. C memoire en parallele des les ASSISTANTS
  285. DO 301 IEL=1,N1EL
  286. DO 302 INO=1,NBNO
  287. INOEU=IPT2.NUM(INO,IEL)
  288. IF(ICPR(INOEU) .NE. 0)GOTO 302
  289. NX=NX+1
  290. ICPR(INOEU)=NX
  291. 302 CONTINUE
  292. 301 CONTINUE
  293.  
  294. IF(IPMINT .EQ. 0)THEN
  295. N1PTEL=NBNO
  296. ELSE
  297. MINTE =IPMINT
  298. N1PTEL=SHPTOT(/3)
  299. ENDIF
  300.  
  301. ISAUT(2,ISOUSs) = N1EL
  302. ISAUT(3,ISOUSs) = N1PTEL
  303.  
  304. NT2 = MAX(NT2,N1EL*N1PTEL)
  305. 19 CONTINUE
  306.  
  307. C Creation d'un MAXIMUM de SEGMENTS dans un LOCK
  308. N1=ISOUSs
  309. IF(OOTHRD .NE.0) call oooprl(1)
  310. SEGINI,MCHELM
  311. DO ISOUSs=1,N1
  312. SEGINI,MCHAML
  313. ICHAML(ISOUSs)=MCHAML
  314. N1EL =ISAUT(2,ISOUSs)
  315. N1PTEL=ISAUT(3,ISOUSs)
  316. DO ICOMP=1,N2
  317. SEGINI,MELVAL
  318. IELVAL(ICOMP)=MELVAL
  319. ENDDO
  320. ENDDO
  321. SEGINI,MTRA2
  322. IF(OOTHRD .NE.0) call oooprl(0)
  323.  
  324. TITCHE=SOUTYP
  325. IFOCHE=IFOUR
  326.  
  327. NCO = 0
  328. DO ISOUPO=1,NSOUPO
  329. MSOUPO=IPCHP(ISOUPO)
  330. MELEME=IGEOC
  331. NT1 =MAX(NT1,NUM(/2))
  332. NC =MSOUPO.NOHARM(/1)
  333. DO 101 ICO=1,NC
  334. MO4=MSOUPO.NOCOMP(ICO)
  335. DO K=1,NCO
  336. IF(MO4 .EQ. MTRA2.INCO(K))GOTO 101
  337. ENDDO
  338. NCO = NCO + 1
  339. K = NCO
  340. MTRA2.INCO(NCO)=MO4
  341. 101 CONTINUE
  342. ENDDO
  343.  
  344. C----------------------------------------------------------------------C
  345. C Remplissage du MTRA2
  346. C----------------------------------------------------------------------C
  347. NBTHR=MIN(MAX(NT1/IOPTIM,1),NBTHRS)
  348. IF ((NBTHR .EQ. 1) .OR. (NBTHRS .EQ. 1) .OR. (OOTHRD .GT. 0)) THEN
  349. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  350. C DEJA DANS LES ASSISTANTS
  351. NBTHR = 1
  352. BTHRD = .FALSE.
  353. ELSE
  354. BTHRD = .TRUE.
  355. CALL THREADII
  356. ENDIF
  357.  
  358. IF (BTHRD) THEN
  359. C Remplissage du 'COMMON/cham1c'
  360. SEGINI,SPARA1
  361. IPARA1=SPARA1
  362. IPARA2=0
  363.  
  364. SPARA1.NBTHR1=NBTHR
  365. SPARA1.IPCH1 =MCHPOI
  366. SPARA1.IPTP1 =ICPR
  367. SPARA1.IPTR1 =MTRA2
  368.  
  369. DO ith=2,NBTHR
  370. CALL THREADID(ith,CHAM1i)
  371. ENDDO
  372. CALL CHAM1i(1)
  373.  
  374. C Attente de la fin de tous les threads en cours de travail
  375. DO ith=2,NBTHR
  376. CALL THREADIF(ith)
  377. ENDDO
  378.  
  379. C On libère les Threads
  380. CALL THREADIS
  381. SEGSUP,SPARA1
  382.  
  383. ELSE
  384. C Appel de la SUBROUTINE qui fait le travail
  385. ith=1
  386. CALL CHAM11(NBTHR,ith,MCHPOI,ICPR,MTRA2)
  387. ENDIF
  388.  
  389. C----------------------------------------------------------------------C
  390. C Remplissage du MCHAML
  391. C----------------------------------------------------------------------C
  392.  
  393.  
  394. NBTHR=MIN(MAX(NT2/IOPTIM,1),NBTHRS)
  395. IF ((NBTHR .EQ. 1) .OR. (NBTHRS .EQ. 1) .OR. (OOTHRD .GT. 0)) THEN
  396. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  397. C DEJA DANS LES ASSISTANTS
  398. NBTHR = 1
  399. BTHRD = .FALSE.
  400. ELSE
  401. BTHRD = .TRUE.
  402. CALL THREADII
  403. ENDIF
  404.  
  405. IF (BTHRD) THEN
  406. C Remplissage du 'COMMON/cham1c'
  407. SEGINI,SPARA2
  408. IPARA1=0
  409. IPARA2=SPARA2
  410.  
  411. SPARA2.NBTHRD=NBTHR
  412. SPARA2.IISUP =ISUP
  413. SPARA2.IPSAU =ISAUT
  414. SPARA2.IPMOD =IPMODL
  415. SPARA2.IPCHE =MCHELM
  416. SPARA2.IPTPR =ICPR
  417. SPARA2.IPTRA =MTRA2
  418.  
  419. DO ith=2,NBTHR
  420. CALL THREADID(ith,CHAM1i)
  421. ENDDO
  422. CALL CHAM1i(1)
  423.  
  424. C Attente de la fin de tous les threads en cours de travail
  425. DO ith=2,NBTHR
  426. CALL THREADIF(ith)
  427. ENDDO
  428.  
  429. C On libere les Threads
  430. CALL THREADIS
  431. SEGSUP,SPARA2
  432.  
  433. ELSE
  434. C Appel de la SUBROUTINE qui fait le travail
  435. ith=1
  436. CALL CHAM12(NBTHR,ith,ISUP,ISAUT,IPMODL,MCHELM,ICPR,MTRA2)
  437. ENDIF
  438.  
  439. SEGSUP,MTRA2,ISAUT,ICPR
  440. IF(INFO .NE. 0)SEGSUP,INFO
  441.  
  442. IPCHEL=MCHELM
  443.  
  444. END
  445.  
  446.  
  447.  
  448.  
  449.  
  450.  
  451.  

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