Télécharger melmof.eso

Retour à la liste

Numérotation des lignes :

  1. C MELMOF SOURCE BP208322 16/11/18 21:19:11 9177
  2. SUBROUTINE MELMOF(IMDL,MTABD,IHV,TYPE,COEF,XPOI,MCHPOI,MCHELM,
  3. &KPOIND,MUG,MCHELG)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C
  8. C Ce Sp crée un MCHAML a partir d'un FLOTTANT ou d'un CHPOIN
  9. C Le MCHAML en retour est jetable et est calcule aux pts d'integrations
  10. C Le support géométrique du MCHELM (MCHELN) est compatible avec le schema
  11. C d'intégration de l'opérateur
  12. C c'est le MELEME sauf pour les MACRO (INEFMD=2) avec CENTREP0
  13. C CENTREP1 et MSOMMET où MELEME=MACRO1
  14. C----------------------------------------------------------------------
  15. C HISTORIQUE : 20/10/01 : Création
  16. C
  17. C HISTORIQUE :
  18. C
  19. C
  20. C---------------------------
  21. C Paramètres Entrée/Sortie :
  22. C---------------------------
  23. C
  24. C E/ MTABD : Objet model de la zone
  25. C E/ IHV : 0 ou 1 Scalaire ou Vecteur
  26. C E/ TYPE : MOT type du coefficient FLOTTANT VECTEUR CHPOINT
  27. C E/ COEF : FLOTTANT valeur du coef si flottant
  28. C E/ XPOI : POINT valeur du coef si vecteur
  29. C E/ MCHPOI : CHPOINT valeur du coef si chpoint
  30. C /S MCHELM : Chamelem pts d'intégration pour le COEF
  31. C E/ KPOIND : ENTIER type du support GÉométrique DUAL du shéma
  32. C d'intégration différent de KPOINC celui du coef
  33. C cette info sert à la construction du Chamelem
  34. C E/ MUG=0 On rend le coefficient tel quel
  35. C E/ MUG=1 Si le coefficient est un CHPOINT On retourne en plus le gradient
  36. C /S MCHELG : Chamelem pts d'intégration pour le Gradient du coef (=0 sinon)
  37. C----------------------------------------------------------------------
  38. C KPOIN = 0->SOMMET 1-> FACE 2-> CENTRE 3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
  39. C INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE, INEFMD=4 LINB
  40. C************************************************************************
  41.  
  42. -INC SIZFFB
  43. POINTEUR IZF1.IZFFM,IZH2.IZHR,IZFD.IZFFM
  44. SEGMENT SAJT
  45. REAL*8 AJT(IDIM,IDIM,NPG)
  46. ENDSEGMENT
  47. -INC SMCHAML
  48. POINTEUR MCHELG.MCHELM
  49. -INC SMCHPOI
  50. -INC SMELEME
  51. POINTEUR IGEOM.MELEME
  52. POINTEUR MELEMD.MELEME,SPGD.MELEME,MELEM1.MELEME,MELEMC.MELEME
  53. -INC SMLENTI
  54. -INC SMCOORD
  55. -INC CCOPTIO
  56. -INC CCGEOME
  57. CHARACTER*4 NOMD4
  58. CHARACTER*8 TYPE,NOM0
  59. DIMENSION XPOI(3)
  60. C*****************************************************************************
  61. CMELMOF
  62. c write(6,*)' DEBUT MELMOF MUG=',MUG
  63.  
  64. MCHELG=0
  65.  
  66. XPETI=1.D-30
  67. IAXI=0
  68. IF(IFOMOD.EQ.0)IAXI=2
  69. C
  70. CALL ACME(MTABD,'INEFMD',INEFMD)
  71. c write(6,*)'INEFMD=',INEFMD
  72.  
  73. CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
  74. IF(INEFMD.EQ.2.AND.
  75. & (KPOIND.EQ.3.OR.KPOIND.EQ.4.OR.KPOIND.EQ.5))THEN
  76. CALL LEKTAB(MTABD,'MACRO1',MELEME)
  77. ENDIF
  78.  
  79. SEGACT MELEME
  80.  
  81. L1=72
  82. N1=MAX(1,LISOUS(/1))
  83. N2=1
  84. N3=6
  85. SEGINI MCHELM
  86.  
  87. C-------------------------------------------------------------------------
  88. C__MCHAML
  89. c write(6,*)' MELMOF TYPE=',TYPE
  90. IF(TYPE.EQ.'MCHAML'.AND.IMDL.EQ.0)THEN
  91. C% Le type d'inconnue %m1:8 ne convient pas.
  92. CALL ERREUR(927)
  93. RETURN
  94. ENDIF
  95. IF(TYPE.EQ.'MCHAML')THEN
  96.  
  97. ITEST=0
  98. IREDU=0
  99. MCHEL1=MCHPOI
  100. 452 CONTINUE
  101. SEGACT MCHEL1
  102. NN1=MCHEL1.IMACHE(/1)
  103. IF(NN1.NE.N1)THEN
  104. c write(6,*)' NN1 différent de N1',N1,NN1,MCHEL1,ITEST
  105. ITEST=ITEST+1
  106. IF(ITEST.GT.1)THEN
  107. C% Le nombre de sous-zones du chamelem est supérieur au nombre de
  108. C% sous-zones du modèle
  109. CALL ERREUR(553)
  110. RETURN
  111. ENDIF
  112. ENDIF
  113.  
  114. SEGACT MELEME
  115. DO 455 L=1,MAX(1,LISOUS(/1))
  116. IPT1=MELEME
  117. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  118. IPT2=MCHEL1.IMACHE(L)
  119. c write(6,*)' IPT1=',IPT1,' IPT2=',IPT2
  120. IF(IPT1.NE.IPT2)THEN
  121. ITEST=1
  122. GO TO 456
  123. ENDIF
  124. 455 CONTINUE
  125. 456 CONTINUE
  126.  
  127. IF(ITEST.EQ.1.AND.IREDU.EQ.0)THEN
  128. IREDU=1
  129. c write(6,*)' On reduiiit'
  130. CALL ECROBJ('MMODEL',IMDL)
  131. CALL ECROBJ('MCHAML',MCHEL1)
  132. CALL REDU
  133. CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
  134. IF(IRETOU.EQ.0)THEN
  135. CALL ERREUR(920)
  136. RETURN
  137. ENDIF
  138. GO TO 452
  139. ENDIF
  140.  
  141. SEGACT MCHEL1
  142. MCHAM1=MCHEL1.ICHAML(1)
  143. SEGACT MCHAM1
  144. MELVA1=MCHAM1.IELVAL(1)
  145. SEGACT MELVA1
  146.  
  147.  
  148. SEGACT MELEME
  149.  
  150. DO 371 L=1,MAX(1,LISOUS(/1))
  151. IPT1=MELEME
  152. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  153. SEGACT IPT1
  154.  
  155. NOM0 = NOMS(IPT1.ITYPEL)//' '
  156. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  157. SEGACT IZFFM
  158. IZHR=KZHR(1)
  159. SEGACT IZHR*MOD
  160. IZF1=KTP(1)
  161. IZH2=KZHR(2)
  162.  
  163. NES=GR(/1)
  164. NPG=GR(/3)
  165.  
  166. NBNN =IPT1.NUM(/1)
  167. NBELEM=IPT1.NUM(/2)
  168. SEGINI MCHAML
  169. IDU=1
  170. IF(IHV.EQ.1)IDU=IDIM
  171. SEGINI SAJT
  172. N1PTEL=NPG*IDU
  173. N1EL =NBELEM
  174. N2PTEL=0
  175. N2EL=0
  176.  
  177. IMACHE(L)=IPT1
  178. ICHAML(L)=MCHAML
  179.  
  180. MCHAM1=MCHEL1.ICHAML(L)
  181. SEGACT MCHAM1
  182. MELVA1=MCHAM1.IELVAL(1)
  183. SEGACT MELVA1
  184.  
  185. SEGINI MELVAL
  186. IELVAL(1)=MELVAL
  187.  
  188. DO 375 K=1,NBELEM
  189. COEF=MELVA1.VELCHE(1,K)
  190.  
  191. IF(IHV.EQ.0)THEN
  192. DO 372 LG=1,NPG
  193. VELCHE(LG,K)=COEF
  194. 372 CONTINUE
  195. ELSEIF(IHV.EQ.1)THEN
  196. DO 374 N =1,IDIM
  197. DO 374 LG=1,NPG
  198. VELCHE(LG+(N-1)*NPG,1)=XPOI(N)
  199. 374 CONTINUE
  200. ENDIF
  201. 375 CONTINUE
  202.  
  203. SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
  204. SEGDES IPT1,MCHAML,MELVAL
  205. 371 CONTINUE
  206. SEGDES MCHELM,MELEME
  207.  
  208.  
  209. C__FLOTTANT ENTIER ou POINT
  210. ELSEIF(TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER'.OR.
  211. & TYPE.EQ.'POINT' )THEN
  212. c write(6,*)' MELMOF CAS ENTIER OU POINT : TYPE=',TYPE
  213.  
  214.  
  215. DO 171 L=1,MAX(1,LISOUS(/1))
  216. IPT1=MELEME
  217. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  218. SEGACT IPT1
  219.  
  220. NOM0 = NOMS(IPT1.ITYPEL)//' '
  221. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  222. SEGACT IZFFM
  223. IZHR=KZHR(1)
  224. SEGACT IZHR*MOD
  225. IZF1=KTP(1)
  226. IZH2=KZHR(2)
  227.  
  228. NES=GR(/1)
  229. NPG=GR(/3)
  230.  
  231. NBNN =IPT1.NUM(/1)
  232. NBELEM=IPT1.NUM(/2)
  233. SEGINI MCHAML
  234. IDU=1
  235. IF(IHV.EQ.1)IDU=IDIM
  236. SEGINI SAJT
  237. N1PTEL=NPG*IDU
  238. N1EL =1
  239. N2PTEL=0
  240. N2EL=0
  241.  
  242. IMACHE(L)=IPT1
  243. ICHAML(L)=MCHAML
  244.  
  245. SEGINI MELVAL
  246. IELVAL(1)=MELVAL
  247.  
  248. IF(IHV.EQ.0)THEN
  249. DO 172 LG=1,NPG
  250. VELCHE(LG,1)=COEF
  251. 172 CONTINUE
  252. ELSEIF(IHV.EQ.1)THEN
  253. DO 174 N =1,IDIM
  254. DO 174 LG=1,NPG
  255. VELCHE(LG+(N-1)*NPG,1)=XPOI(N)
  256. 174 CONTINUE
  257. ENDIF
  258.  
  259. SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
  260. SEGDES IPT1,MCHAML,MELVAL
  261. 171 CONTINUE
  262. SEGDES MCHELM,MELEME
  263.  
  264. C__CHPOINT
  265. ELSEIF(TYPE.EQ.'CHPOINT')THEN
  266. c write(6,*)' MELMOF CAS CHPOINT'
  267.  
  268. IF(IHV.EQ.0.AND.MUG.EQ.1)THEN
  269. C ON SORT LE GRADIENT DU COEFFICIENT EN PLUS
  270. MUVARI=1
  271. L1=72
  272. N1=MAX(1,LISOUS(/1))
  273. N2=1
  274. N3=6
  275. SEGINI MCHELG
  276. ELSE
  277. MUVARI=0
  278. ENDIF
  279.  
  280. SEGACT MCHPOI
  281. NSOUPO=IPCHP(/1)
  282.  
  283. IF(NSOUPO.EQ.1) THEN
  284. MSOUPO=IPCHP(1)
  285. SEGACT MSOUPO
  286. IGEOM=IGEOC
  287. MPOVAL=IPOVAL
  288. SEGDES MSOUPO
  289. SEGACT MPOVAL
  290. NC=VPOCHA(/2)
  291. C On ne traite que les coefficients scalaires
  292. IF(IHV.EQ.0.AND.NC.NE.1)THEN
  293. c write(6,*)' MELMOF IHV=',IHV,' NC=',NC
  294. CALL ERREUR(788)
  295. RETURN
  296. ENDIF
  297. IF(IHV.EQ.1.AND.NC.NE.IDIM)THEN
  298. c write(6,*)' MELMOF IHV=',IHV,' NC=',NC
  299. CALL ERREUR(788)
  300. RETURN
  301. ENDIF
  302. ELSE
  303. CALL ERREUR(788)
  304. RETURN
  305. ENDIF
  306.  
  307. c write(6,*)' IGEOM=',IGEOM
  308. CALL KRIPAD(IGEOM,MLENTI)
  309.  
  310. KPOINC=0
  311. NOMD4= ' '
  312. CALL LEKTAB(MTABD,'MAILLAGE',MELEMD)
  313.  
  314. IF(INEFMD.EQ.2.AND.
  315. & (KPOIND.EQ.3.OR.KPOIND.EQ.4.OR.KPOIND.EQ.5))THEN
  316. CALL LEKTAB(MTABD,'MACRO1',MELEMD)
  317. ENDIF
  318.  
  319. CALL LEKTAB(MTABD,'SOMMET',SPGD)
  320. CALL VERPAD(MLENTI,SPGD,IRET)
  321. c write(6,*)' SOMMET (0 OK) ',SPGD,iret
  322. SEGDES SPGD
  323. IF(IRET.EQ.0)GO TO 180
  324. KPOINC=2
  325. NOMD4= ' '
  326. CALL LEKTAB(MTABD,'CENTRE',MELEMD)
  327. CALL LEKTAB(MTABD,'CENTRE',SPGD)
  328. CALL VERPAD(MLENTI,SPGD,IRET)
  329. c write(6,*)' CENTRE (0 OK) ',SPGD,iret
  330. SEGDES SPGD
  331. IF(INEFMD.EQ.3)THEN
  332. KPOINC=3
  333. NOMD4= 'PRP0'
  334. ENDIF
  335. IF(IRET.EQ.0)GO TO 180
  336. KPOINC=5
  337. NOMD4= 'P1P1'
  338. IF(INEFMD.EQ.2)NOMD4= 'MCF1'
  339. IF(INEFMD.EQ.3)NOMD4= 'PFP1'
  340. CALL LEKTAB(MTABD,'MMAIL ',MELEMD)
  341. CALL LEKTAB(MTABD,'MSOMMET',SPGD)
  342. CALL VERPAD(MLENTI,SPGD,IRET)
  343. c write(6,*)'MSOMMET (0 OK) ',SPGD,iret
  344. SEGDES SPGD
  345. IF(IRET.EQ.0)GO TO 180
  346. IF(INEFMD.EQ.2.OR.INEFMD.EQ.3)THEN
  347. KPOINC=4
  348. NOMD4= ' '
  349. IF(INEFMD.EQ.2)NOMD4= 'MCP1'
  350. IF(INEFMD.EQ.3)NOMD4= 'PRP1'
  351. CALL LEKTAB(MTABD,'ELTP1NC ',MELEMD)
  352. CALL LEKTAB(MTABD,'CENTREP1',SPGD)
  353. CALL VERPAD(MLENTI,SPGD,IRET)
  354. c write(6,*)'CENTREP1 (0 OK) ',SPGD,iret
  355. SEGDES SPGD
  356. IF(IRET.EQ.0)GO TO 180
  357. KPOINC=3
  358. NOMD4= ' '
  359. IF(INEFMD.EQ.2)NOMD4= 'MCP0'
  360. IF(INEFMD.EQ.3)NOMD4= 'PRP0'
  361. CALL LEKTAB(MTABD,'CENTREP0',MELEMD)
  362. CALL LEKTAB(MTABD,'CENTREP0',SPGD)
  363. CALL VERPAD(MLENTI,SPGD,IRET)
  364. SEGDES SPGD
  365. IF(IRET.EQ.0)GO TO 180
  366. ENDIF
  367.  
  368. C__CHPOINT_SUPPORT_INCONU
  369. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  370. MOTERR(1: 8) = 'CHPOINT '
  371. MOTERR(9:16) = ' COEF '
  372. CALL ERREUR(788)
  373. RETURN
  374. 180 CONTINUE
  375. SEGDES IGEOM
  376. C__CHPOINT
  377. c write(6,*)' CAs CHPOIN '
  378.  
  379. SEGACT MELEMD
  380.  
  381. NKD0=0
  382. DO 191 L=1,MAX(1,LISOUS(/1))
  383. IPT1=MELEME
  384. IPT2=MELEMD
  385. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  386. SEGACT IPT1
  387. IF(MELEMD.LISOUS(/1).NE.0)IPT2=MELEMD.LISOUS(L)
  388. SEGACT IPT2
  389. IF(MELEMD.LISOUS(/1).NE.0)NKD0=0
  390. MP=IPT2.NUM(/1)
  391.  
  392. C-----------------------------------------------------------------------
  393. IF(KPOIND.NE.2)THEN
  394. IF(INEFMD.EQ.3)THEN
  395. IF(KPOIND.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  396. IF(KPOIND.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  397. IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'PFP1'
  398. ELSEIF(INEFMD.EQ.2)THEN
  399. IF(KPOIND.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  400. IF(KPOIND.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  401. IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'MCF1'
  402. ELSEIF(INEFMD.EQ.1)THEN
  403. IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'P1P1'
  404. ELSEIF(INEFMD.EQ.4)THEN
  405. NOM0=NOMS(IPT1.ITYPEL)//' '
  406. ENDIF
  407. ENDIF
  408.  
  409. IF(KPOIND.EQ.2)THEN
  410. NOM0 = NOMS(IPT1.ITYPEL)//NOMD4
  411. ENDIF
  412.  
  413. IF(KPOIND.EQ.0)THEN
  414. NOM0 = NOMS(IPT1.ITYPEL)
  415. NOM0 = NOMS(IPT1.ITYPEL)//NOMD4
  416. ENDIF
  417.  
  418. C-----------------------------------------------------------------------
  419. cc write(6,*)' MELMOF 2 KPOIND=',KPOIND,' NOMS=',NOMS(IPT1.ITYPEL),
  420. cc & ' NOMD4=',NOMD4,' NOM0=',NOM0
  421. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  422. SEGACT IZFFM
  423. IZHR=KZHR(1)
  424. IZF1=KTP(1)
  425. IZH2=KZHR(2)
  426. SEGACT IZHR*MOD
  427.  
  428. IZFD=IZF1
  429. IF(KPOINC.EQ.0)IZFD=IZFFM
  430. SEGACT IZFD*MOD
  431. IF(MP.NE.IZFD.FN(/1))THEN
  432. write(6,*)' Gross problem dans MELMOF'
  433. write(6,*)' INEFMD=',INEFMD,' NOMD4=',NOMD4
  434. write(6,*)' MP=',MP,' KPOINC.=',KPOINC,' IZFD.FN(/1)='
  435. & ,IZFD.FN(/1)
  436. ENDIF
  437.  
  438.  
  439. NES=GR(/1)
  440. NP =GR(/2)
  441. NPG=GR(/3)
  442.  
  443. NBNN =IPT1.NUM(/1)
  444. NBELEM=IPT1.NUM(/2)
  445. SEGINI MCHAML
  446.  
  447. IDU=1
  448. IF(IHV.EQ.1)IDU=IDIM
  449. SEGINI SAJT
  450. N1PTEL=NPG*IDU
  451. N1EL =NBELEM
  452. N2PTEL=0
  453. N2EL=0
  454. IMACHE(L)=IPT1
  455. ICHAML(L)=MCHAML
  456.  
  457. SEGINI MELVAL
  458. IELVAL(1)=MELVAL
  459.  
  460. C......................................MUVARI..DEBUT
  461. IF(MUVARI.EQ.1)THEN
  462. N2=IDIM
  463. SEGINI MCHAM1
  464. N1PTEL=NBNN
  465. N1EL =NBELEM
  466. N2PTEL=0
  467. N2EL=0
  468. MCHELG.IMACHE(L)=IPT1
  469. MCHELG.ICHAML(L)=MCHAM1
  470.  
  471. SEGINI MELVA1
  472. MCHAM1.IELVAL(1)=MELVA1
  473.  
  474. ENDIF
  475. C......................................MUVARI..FIN
  476.  
  477. ID1=1
  478. IF(IHV.EQ.1)ID1=IDIM
  479.  
  480. NKD=NKD0
  481. DO 192 K=1,N1EL
  482. NKD=NKD+1
  483. DO 194 N=1,ID1
  484. DO 194 LG=1,NPG
  485. U=0.D0
  486. DO 193 I=1,MP
  487. I1=LECT(IPT2.NUM(I,NKD))
  488. U=U+IZFD.FN(I,LG)*VPOCHA(I1,N)
  489. 193 CONTINUE
  490. VELCHE(LG+(N-1)*NPG,K)=U
  491. 194 CONTINUE
  492. 192 CONTINUE
  493.  
  494. SEGDES MELVAL,MCHAML
  495.  
  496. C......................................MUVARI..DEBUT
  497. IF(MUVARI.EQ.1)THEN
  498.  
  499. NKD=NKD0
  500. DO 292 K=1,N1EL
  501. NKD=NKD+1
  502. DO 293 I=1,MP
  503. I1=LECT(IPT2.NUM(I,NKD))
  504. MELVA1.VELCHE(I,K)=VPOCHA(I1,1)
  505. 293 CONTINUE
  506. 292 CONTINUE
  507.  
  508. SEGDES MELVA1,MCHAM1
  509.  
  510. ENDIF
  511. C......................................MUVARI..FIN
  512.  
  513. NKD0=NKD
  514. SEGDES IPT1
  515. SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
  516.  
  517. 191 CONTINUE
  518. SEGDES MCHELM
  519. IF(MUVARI.EQ.1)SEGDES MCHELG
  520.  
  521. SEGDES MCHPOI,MSOUPO,MPOVAL
  522. SEGDES MELEME
  523. SEGSUP MLENTI
  524.  
  525.  
  526. ENDIF
  527.  
  528. C*************************************************************************
  529.  
  530. c write(6,*)' FIN MELMOF '
  531. RETURN
  532. 1001 FORMAT(20(1X,I5))
  533. 1002 FORMAT(10(1X,1PE11.4))
  534. END
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  

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