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

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