Télécharger melmof.eso

Retour à la liste

Numérotation des lignes :

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

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