Télécharger melmof.eso

Retour à la liste

Numérotation des lignes :

melmof
  1. C MELMOF SOURCE CB215821 20/11/25 13:34:17 10792
  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 374 N =1,IDIM
  198. DO 374 LG=1,NPG
  199. VELCHE(LG+(N-1)*NPG,1)=XPOI(N)
  200. 374 CONTINUE
  201. ENDIF
  202. 375 CONTINUE
  203.  
  204. SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
  205. SEGDES IPT1,MCHAML,MELVAL
  206. 371 CONTINUE
  207. SEGDES MCHELM,MELEME
  208.  
  209.  
  210. C__FLOTTANT ENTIER ou POINT
  211. ELSEIF(TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER'.OR.
  212. & TYPE.EQ.'POINT' )THEN
  213. c write(6,*)' MELMOF CAS ENTIER OU POINT : TYPE=',TYPE
  214.  
  215.  
  216. DO 171 L=1,MAX(1,LISOUS(/1))
  217. IPT1=MELEME
  218. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  219. SEGACT IPT1
  220.  
  221. NOM0 = NOMS(IPT1.ITYPEL)//' '
  222. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  223. SEGACT IZFFM
  224. IZHR=KZHR(1)
  225. SEGACT IZHR*MOD
  226. IZF1=KTP(1)
  227. IZH2=KZHR(2)
  228.  
  229. NES=GR(/1)
  230. NPG=GR(/3)
  231.  
  232. NBNN =IPT1.NUM(/1)
  233. NBELEM=IPT1.NUM(/2)
  234. SEGINI MCHAML
  235. IDU=1
  236. IF(IHV.EQ.1)IDU=IDIM
  237. SEGINI SAJT
  238. N1PTEL=NPG*IDU
  239. N1EL =1
  240. N2PTEL=0
  241. N2EL=0
  242.  
  243. IMACHE(L)=IPT1
  244. ICHAML(L)=MCHAML
  245.  
  246. SEGINI MELVAL
  247. IELVAL(1)=MELVAL
  248.  
  249. IF(IHV.EQ.0)THEN
  250. DO 172 LG=1,NPG
  251. VELCHE(LG,1)=COEF
  252. 172 CONTINUE
  253. ELSEIF(IHV.EQ.1)THEN
  254. DO 174 N =1,IDIM
  255. DO 174 LG=1,NPG
  256. VELCHE(LG+(N-1)*NPG,1)=XPOI(N)
  257. 174 CONTINUE
  258. ENDIF
  259.  
  260. SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
  261. SEGDES IPT1,MCHAML,MELVAL
  262. 171 CONTINUE
  263. SEGDES MCHELM,MELEME
  264.  
  265. C__CHPOINT
  266. ELSEIF(TYPE.EQ.'CHPOINT')THEN
  267. c write(6,*)' MELMOF CAS CHPOINT'
  268.  
  269. IF(IHV.EQ.0.AND.MUG.EQ.1)THEN
  270. C ON SORT LE GRADIENT DU COEFFICIENT EN PLUS
  271. MUVARI=1
  272. L1=72
  273. N1=MAX(1,LISOUS(/1))
  274. N2=1
  275. N3=6
  276. SEGINI MCHELG
  277. ELSE
  278. MUVARI=0
  279. ENDIF
  280.  
  281. SEGACT MCHPOI
  282. NSOUPO=IPCHP(/1)
  283.  
  284. IF(NSOUPO.EQ.1) THEN
  285. MSOUPO=IPCHP(1)
  286. SEGACT MSOUPO
  287. IGEOM=IGEOC
  288. MPOVAL=IPOVAL
  289. SEGDES MSOUPO
  290. SEGACT MPOVAL
  291. NC=VPOCHA(/2)
  292. C On ne traite que les coefficients scalaires
  293. IF(IHV.EQ.0.AND.NC.NE.1)THEN
  294. c write(6,*)' MELMOF IHV=',IHV,' NC=',NC
  295. CALL ERREUR(788)
  296. RETURN
  297. ENDIF
  298. IF(IHV.EQ.1.AND.NC.NE.IDIM)THEN
  299. c write(6,*)' MELMOF IHV=',IHV,' NC=',NC
  300. CALL ERREUR(788)
  301. RETURN
  302. ENDIF
  303. ELSE
  304. CALL ERREUR(788)
  305. RETURN
  306. ENDIF
  307.  
  308. c write(6,*)' IGEOM=',IGEOM
  309. CALL KRIPAD(IGEOM,MLENTI)
  310.  
  311. KPOINC=0
  312. NOMD4= ' '
  313. CALL LEKTAB(MTABD,'MAILLAGE',MELEMD)
  314.  
  315. IF(INEFMD.EQ.2.AND.
  316. & (KPOIND.EQ.3.OR.KPOIND.EQ.4.OR.KPOIND.EQ.5))THEN
  317. CALL LEKTAB(MTABD,'MACRO1',MELEMD)
  318. ENDIF
  319.  
  320. CALL LEKTAB(MTABD,'SOMMET',SPGD)
  321. CALL VERPAD(MLENTI,SPGD,IRET)
  322. c write(6,*)' SOMMET (0 OK) ',SPGD,iret
  323. SEGDES SPGD
  324. IF(IRET.EQ.0)GO TO 180
  325. KPOINC=2
  326. NOMD4= ' '
  327. CALL LEKTAB(MTABD,'CENTRE',MELEMD)
  328. CALL LEKTAB(MTABD,'CENTRE',SPGD)
  329. CALL VERPAD(MLENTI,SPGD,IRET)
  330. c write(6,*)' CENTRE (0 OK) ',SPGD,iret
  331. SEGDES SPGD
  332. IF(INEFMD.EQ.3)THEN
  333. KPOINC=3
  334. NOMD4= 'PRP0'
  335. ENDIF
  336. IF(IRET.EQ.0)GO TO 180
  337. KPOINC=5
  338. NOMD4= 'P1P1'
  339. IF(INEFMD.EQ.2)NOMD4= 'MCF1'
  340. IF(INEFMD.EQ.3)NOMD4= 'PFP1'
  341. CALL LEKTAB(MTABD,'MMAIL ',MELEMD)
  342. CALL LEKTAB(MTABD,'MSOMMET',SPGD)
  343. CALL VERPAD(MLENTI,SPGD,IRET)
  344. c write(6,*)'MSOMMET (0 OK) ',SPGD,iret
  345. SEGDES SPGD
  346. IF(IRET.EQ.0)GO TO 180
  347. IF(INEFMD.EQ.2.OR.INEFMD.EQ.3)THEN
  348. KPOINC=4
  349. NOMD4= ' '
  350. IF(INEFMD.EQ.2)NOMD4= 'MCP1'
  351. IF(INEFMD.EQ.3)NOMD4= 'PRP1'
  352. CALL LEKTAB(MTABD,'ELTP1NC ',MELEMD)
  353. CALL LEKTAB(MTABD,'CENTREP1',SPGD)
  354. CALL VERPAD(MLENTI,SPGD,IRET)
  355. c write(6,*)'CENTREP1 (0 OK) ',SPGD,iret
  356. SEGDES SPGD
  357. IF(IRET.EQ.0)GO TO 180
  358. KPOINC=3
  359. NOMD4= ' '
  360. IF(INEFMD.EQ.2)NOMD4= 'MCP0'
  361. IF(INEFMD.EQ.3)NOMD4= 'PRP0'
  362. CALL LEKTAB(MTABD,'CENTREP0',MELEMD)
  363. CALL LEKTAB(MTABD,'CENTREP0',SPGD)
  364. CALL VERPAD(MLENTI,SPGD,IRET)
  365. SEGDES SPGD
  366. IF(IRET.EQ.0)GO TO 180
  367. ENDIF
  368.  
  369. C__CHPOINT_SUPPORT_INCONU
  370. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  371. MOTERR(1: 8) = 'CHPOINT '
  372. MOTERR(9:16) = ' COEF '
  373. CALL ERREUR(788)
  374. RETURN
  375. 180 CONTINUE
  376. SEGDES IGEOM
  377. C__CHPOINT
  378. c write(6,*)' CAs CHPOIN '
  379.  
  380. SEGACT MELEMD
  381.  
  382. NKD0=0
  383. DO 191 L=1,MAX(1,LISOUS(/1))
  384. IPT1=MELEME
  385. IPT2=MELEMD
  386. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  387. SEGACT IPT1
  388. IF(MELEMD.LISOUS(/1).NE.0)IPT2=MELEMD.LISOUS(L)
  389. SEGACT IPT2
  390. IF(MELEMD.LISOUS(/1).NE.0)NKD0=0
  391. MP=IPT2.NUM(/1)
  392.  
  393. C-----------------------------------------------------------------------
  394. IF(KPOIND.NE.2)THEN
  395. IF(INEFMD.EQ.3)THEN
  396. IF(KPOIND.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  397. IF(KPOIND.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  398. IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'PFP1'
  399. ELSEIF(INEFMD.EQ.2)THEN
  400. IF(KPOIND.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  401. IF(KPOIND.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  402. IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'MCF1'
  403. ELSEIF(INEFMD.EQ.1)THEN
  404. IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'P1P1'
  405. ELSEIF(INEFMD.EQ.4)THEN
  406. NOM0=NOMS(IPT1.ITYPEL)//' '
  407. ENDIF
  408. ENDIF
  409.  
  410. IF(KPOIND.EQ.2)THEN
  411. NOM0 = NOMS(IPT1.ITYPEL)//NOMD4
  412. ENDIF
  413.  
  414. IF(KPOIND.EQ.0)THEN
  415. NOM0 = NOMS(IPT1.ITYPEL)
  416. NOM0 = NOMS(IPT1.ITYPEL)//NOMD4
  417. ENDIF
  418.  
  419. C-----------------------------------------------------------------------
  420. cc write(6,*)' MELMOF 2 KPOIND=',KPOIND,' NOMS=',NOMS(IPT1.ITYPEL),
  421. cc & ' NOMD4=',NOMD4,' NOM0=',NOM0
  422. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  423. SEGACT IZFFM
  424. IZHR=KZHR(1)
  425. IZF1=KTP(1)
  426. IZH2=KZHR(2)
  427. SEGACT IZHR*MOD
  428.  
  429. IZFD=IZF1
  430. IF(KPOINC.EQ.0)IZFD=IZFFM
  431. SEGACT IZFD*MOD
  432. IF(MP.NE.IZFD.FN(/1))THEN
  433. write(6,*)' Gross problem dans MELMOF'
  434. write(6,*)' INEFMD=',INEFMD,' NOMD4=',NOMD4
  435. write(6,*)' MP=',MP,' KPOINC.=',KPOINC,' IZFD.FN(/1)='
  436. & ,IZFD.FN(/1)
  437. ENDIF
  438.  
  439.  
  440. NES=GR(/1)
  441. NP =GR(/2)
  442. NPG=GR(/3)
  443.  
  444. NBNN =IPT1.NUM(/1)
  445. NBELEM=IPT1.NUM(/2)
  446. SEGINI MCHAML
  447.  
  448. IDU=1
  449. IF(IHV.EQ.1)IDU=IDIM
  450. SEGINI SAJT
  451. N1PTEL=NPG*IDU
  452. N1EL =NBELEM
  453. N2PTEL=0
  454. N2EL=0
  455. IMACHE(L)=IPT1
  456. ICHAML(L)=MCHAML
  457.  
  458. SEGINI MELVAL
  459. IELVAL(1)=MELVAL
  460.  
  461. C......................................MUVARI..DEBUT
  462. IF(MUVARI.EQ.1)THEN
  463. N2=IDIM
  464. SEGINI MCHAM1
  465. N1PTEL=NBNN
  466. N1EL =NBELEM
  467. N2PTEL=0
  468. N2EL=0
  469. MCHELG.IMACHE(L)=IPT1
  470. MCHELG.ICHAML(L)=MCHAM1
  471.  
  472. SEGINI MELVA1
  473. MCHAM1.IELVAL(1)=MELVA1
  474.  
  475. ENDIF
  476. C......................................MUVARI..FIN
  477.  
  478. ID1=1
  479. IF(IHV.EQ.1)ID1=IDIM
  480.  
  481. NKD=NKD0
  482. DO 192 K=1,N1EL
  483. NKD=NKD+1
  484. DO 194 N=1,ID1
  485. DO 194 LG=1,NPG
  486. U=0.D0
  487. DO 193 I=1,MP
  488. I1=LECT(IPT2.NUM(I,NKD))
  489. U=U+IZFD.FN(I,LG)*VPOCHA(I1,N)
  490. 193 CONTINUE
  491. VELCHE(LG+(N-1)*NPG,K)=U
  492. 194 CONTINUE
  493. 192 CONTINUE
  494.  
  495. SEGDES MELVAL,MCHAML
  496.  
  497. C......................................MUVARI..DEBUT
  498. IF(MUVARI.EQ.1)THEN
  499.  
  500. NKD=NKD0
  501. DO 292 K=1,N1EL
  502. NKD=NKD+1
  503. DO 293 I=1,MP
  504. I1=LECT(IPT2.NUM(I,NKD))
  505. MELVA1.VELCHE(I,K)=VPOCHA(I1,1)
  506. 293 CONTINUE
  507. 292 CONTINUE
  508.  
  509. SEGDES MELVA1,MCHAM1
  510.  
  511. ENDIF
  512. C......................................MUVARI..FIN
  513.  
  514. NKD0=NKD
  515. SEGDES IPT1
  516. SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
  517.  
  518. 191 CONTINUE
  519. SEGDES MCHELM
  520. IF(MUVARI.EQ.1)SEGDES MCHELG
  521.  
  522. SEGDES MCHPOI,MSOUPO,MPOVAL
  523. SEGDES MELEME
  524. SEGSUP MLENTI
  525.  
  526.  
  527. ENDIF
  528.  
  529. C*************************************************************************
  530.  
  531. c write(6,*)' FIN MELMOF '
  532. RETURN
  533. 1001 FORMAT(20(1X,I5))
  534. 1002 FORMAT(10(1X,1PE11.4))
  535. END
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  

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