Télécharger chame1.eso

Retour à la liste

Numérotation des lignes :

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

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