Télécharger meldiv.eso

Retour à la liste

Numérotation des lignes :

  1. C MELDIV SOURCE BP208322 16/11/18 21:19:11 9177
  2. SUBROUTINE MELDIV(MTABD,MCHPOI,MCHELM,KPOIND)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C Ce Sp crée un MCHAML a partir d'un FLOTTANT ou d'un CHPOIN
  8. C Le MCHAML en retour est jetable et est calcule aux pts d'integrations
  9. C Le support géométrique du MCHELM est compatible avec le schema
  10. C d'intégration de l'opérateur
  11. C c'est le MELEME sauf pour les MACRO (INEFMD=2) avec CENTREP0
  12. C CENTREP1 et MSOMMET où MELEME=MACRO1
  13. C----------------------------------------------------------------------
  14. C HISTORIQUE : 20/10/01 : Création
  15. C
  16. C HISTORIQUE :
  17. C
  18. C
  19. C---------------------------
  20. C Paramètres Entrée/Sortie :
  21. C---------------------------
  22. C
  23. C E/ MTABD : Objet model de la zone
  24. C E/ MCHPOI : CHPOINT valeur du coef si chpoint (chpoint vecteur)
  25. C /S MCHELM : Chamelem pts d'intégration pour le COEF
  26. C E/ KPOIND : ENTIER type du support GÉométrique DUAL du shéma
  27. C d'intégration différent de KPOINC celui du coef
  28. C cette info sert à la construction du Chamelem
  29. C----------------------------------------------------------------------
  30. C KPOIN = 0->SOMMET 1-> FACE 2-> CENTRE 3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
  31. C************************************************************************
  32.  
  33. -INC SIZFFB
  34. POINTEUR IZF1.IZFFM,IZH2.IZHR,IZFD.IZFFM
  35. SEGMENT SAJT
  36. REAL*8 AJT(IDIM,IDIM,NPG)
  37. ENDSEGMENT
  38. -INC SMCHAML
  39. -INC SMCHPOI
  40. -INC SMELEME
  41. POINTEUR IGEOM.MELEME
  42. POINTEUR MELEMD.MELEME,SPGD.MELEME
  43. -INC SMLENTI
  44. -INC SMCOORD
  45. -INC CCOPTIO
  46. -INC CCGEOME
  47. CHARACTER*4 NOMD4
  48. CHARACTER*8 TYPE,NOM0
  49. DIMENSION XPOI(3)
  50. C*****************************************************************************
  51. CMELDIV
  52. c write(6,*)' DEBUT MELDIV '
  53. XPETI=1.D-30
  54. IAXI=0
  55. IF(IFOMOD.EQ.0)IAXI=2
  56. C
  57. CALL ACME(MTABD,'INEFMD',INEFMD)
  58.  
  59. CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
  60. IF(INEFMD.EQ.2.AND.
  61. & (KPOIND.EQ.3.OR.KPOIND.EQ.4.OR.KPOIND.EQ.5))THEN
  62. CALL LEKTAB(MTABD,'MACRO1',MELEME)
  63. ENDIF
  64.  
  65. SEGACT MELEME
  66.  
  67. L1=72
  68. N1=MAX(1,LISOUS(/1))
  69. N2=1
  70. N3=6
  71. SEGINI MCHELM
  72.  
  73. C-------------------------------------------------------------------------
  74. C__CHPOINT
  75. SEGACT MCHPOI
  76. NSOUPO=IPCHP(/1)
  77.  
  78. IF(NSOUPO.EQ.1) THEN
  79. MSOUPO=IPCHP(1)
  80. SEGACT MSOUPO
  81. IGEOM=IGEOC
  82. MPOVAL=IPOVAL
  83. SEGDES MSOUPO
  84. SEGACT MPOVAL
  85. NC=VPOCHA(/2)
  86. IF(NC.NE.IDIM)THEN
  87. CALL ERREUR(788)
  88. RETURN
  89. ENDIF
  90. ELSE
  91. CALL ERREUR(788)
  92. RETURN
  93. ENDIF
  94.  
  95. c write(6,*)' IGEOM=',IGEOM
  96. CALL KRIPAD(IGEOM,MLENTI)
  97.  
  98. KPOINC=0
  99. NOMD4= ' '
  100. CALL LEKTAB(MTABD,'MAILLAGE',MELEMD)
  101. CALL LEKTAB(MTABD,'SOMMET',SPGD)
  102. CALL VERPAD(MLENTI,SPGD,IRET)
  103. c write(6,*)' SOMMET (0 OK) ',SPGD,iret
  104. SEGDES SPGD
  105. IF(IRET.EQ.0)GO TO 180
  106. KPOINC=2
  107. NOMD4= ' '
  108. CALL LEKTAB(MTABD,'CENTRE',MELEMD)
  109. CALL LEKTAB(MTABD,'CENTRE',SPGD)
  110. CALL VERPAD(MLENTI,SPGD,IRET)
  111. c write(6,*)' CENTRE (0 OK) ',SPGD,iret
  112. SEGDES SPGD
  113. IF(INEFMD.EQ.3)THEN
  114. KPOINC=3
  115. NOMD4= 'PRP0'
  116. ENDIF
  117. IF(IRET.EQ.0)GO TO 180
  118. KPOINC=5
  119. NOMD4= 'P1P1'
  120. IF(INEFMD.EQ.2)NOMD4= 'MCF1'
  121. IF(INEFMD.EQ.3)NOMD4= 'PFP1'
  122. CALL LEKTAB(MTABD,'MMAIL ',MELEMD)
  123. CALL LEKTAB(MTABD,'MSOMMET',SPGD)
  124. CALL VERPAD(MLENTI,SPGD,IRET)
  125. c write(6,*)'MSOMMET (0 OK) ',SPGD,iret
  126. SEGDES SPGD
  127. IF(IRET.EQ.0)GO TO 180
  128. IF(INEFMD.EQ.2.OR.INEFMD.EQ.3)THEN
  129. KPOINC=4
  130. NOMD4= ' '
  131. IF(INEFMD.EQ.2)NOMD4= 'MCP1'
  132. IF(INEFMD.EQ.3)NOMD4= 'PRP1'
  133. CALL LEKTAB(MTABD,'ELTP1NC ',MELEMD)
  134. CALL LEKTAB(MTABD,'CENTREP1',SPGD)
  135. CALL VERPAD(MLENTI,SPGD,IRET)
  136. c write(6,*)'CENTREP1 (0 OK) ',SPGD,iret
  137. SEGDES SPGD
  138. IF(IRET.EQ.0)GO TO 180
  139. KPOINC=3
  140. NOMD4= ' '
  141. IF(INEFMD.EQ.2)NOMD4= 'MCP0'
  142. IF(INEFMD.EQ.3)NOMD4= 'PRP0'
  143. CALL LEKTAB(MTABD,'CENTREP0',MELEMD)
  144. CALL LEKTAB(MTABD,'CENTREP0',SPGD)
  145. CALL VERPAD(MLENTI,SPGD,IRET)
  146. SEGDES SPGD
  147. IF(IRET.EQ.0)GO TO 180
  148. ENDIF
  149.  
  150. C__CHPOINT_SUPPORT_INCONU
  151. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  152. MOTERR(1: 8) = 'CHPOINT '
  153. MOTERR(9:16) = ' COEF '
  154. CALL ERREUR(788)
  155. RETURN
  156. 180 CONTINUE
  157. SEGDES IGEOM
  158. C__CHPOINT
  159. c write(6,*)' CAs CHPOIN '
  160.  
  161. SEGACT MELEMD
  162.  
  163. NKD=0
  164. DO 191 L=1,MAX(1,LISOUS(/1))
  165. IPT1=MELEME
  166. IPT2=MELEMD
  167. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  168. SEGACT IPT1
  169. IF(MELEMD.LISOUS(/1).NE.0)IPT2=MELEMD.LISOUS(L)
  170. SEGACT IPT2
  171. IF(MELEMD.LISOUS(/1).NE.0)NKD=0
  172. MP=IPT2.NUM(/1)
  173.  
  174. NOM0 = NOMS(IPT1.ITYPEL)//NOMD4
  175. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  176. SEGACT IZFFM
  177. IZHR=KZHR(1)
  178. IZF1=KTP(1)
  179. IZH2=KZHR(2)
  180. SEGACT IZHR*MOD
  181.  
  182. IZFD=IZF1
  183. IF(KPOINC.EQ.0)IZFD=IZFFM
  184. SEGACT IZFD*MOD
  185. IF(MP.NE.IZFD.FN(/1))THEN
  186. write(6,*)' Gross problem '
  187. write(6,*)' INEFMD=',INEFMD,' NOMD4=',NOMD4
  188. write(6,*)' MP=',MP,' KPOINC.=',KPOINC,' IZFD.FN(/1)='
  189. & ,IZFD.FN(/1)
  190. ENDIF
  191.  
  192.  
  193. NES=GR(/1)
  194. NPG=GR(/3)
  195.  
  196. NBNN =IPT1.NUM(/1)
  197. NBELEM=IPT1.NUM(/2)
  198. SEGINI MCHAML
  199.  
  200. IDU=IDIM
  201. SEGINI SAJT
  202. N1PTEL=NPG*IDU
  203. N1EL =NBELEM
  204. N2PTEL=0
  205. N2EL=0
  206. IMACHE(L)=IPT1
  207. ICHAML(L)=MCHAML
  208.  
  209. SEGINI MELVAL
  210. IELVAL(1)=MELVAL
  211.  
  212. c write(6,*)' Avt BCL 192 ',N1EL,nbnn,N1PTEL
  213. DO 192 K=1,N1EL
  214.  
  215. DO 109 J=1,NBNN
  216. J1=IPT1.NUM(J,K)
  217. DO 109 N=1,IDIM
  218. XYZ(N,J)=XCOOR((J1-1)*(IDIM+1)+N)
  219. 109 CONTINUE
  220.  
  221. CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
  222. & IDIM,NBNN,NPG,IAXI,AIRE,AJ,SGN)
  223.  
  224. NKD=NKD+1
  225.  
  226. DO 194 LG=1,NPG
  227. U=0.D0
  228. DO 193 N=1,IDIM
  229. DO 193 I=1,MP
  230. I1=LECT(IPT2.NUM(I,NKD))
  231. c U=U+IZFD.FN(I,LG)*VPOCHA(I1,N)
  232. U=U+HR(N,I,LG)*VPOCHA(I1,N)
  233. 193 CONTINUE
  234. VELCHE(LG,K)=U
  235. 194 CONTINUE
  236.  
  237. IF(IAXI.NE.0)THEN
  238. DO 196 LG=1,NPG
  239. U=0.D0
  240. DO 195 I=1,MP
  241. I1=LECT(IPT2.NUM(I,NKD))
  242. U=U+FN(I,LG)*VPOCHA(I1,1)/RPG(LG)
  243. 195 CONTINUE
  244. VELCHE(LG,K)=VELCHE(LG,K)+U
  245. 196 CONTINUE
  246. ENDIF
  247.  
  248. 192 CONTINUE
  249.  
  250.  
  251. SEGDES MELVAL
  252. SEGDES IPT1,MCHAML
  253. SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
  254. 191 CONTINUE
  255. SEGDES MCHPOI,MSOUPO,MPOVAL
  256. SEGDES MCHELM,MELEME
  257.  
  258. SEGSUP MLENTI
  259.  
  260.  
  261.  
  262. C*************************************************************************
  263.  
  264. c write(6,*)' FIN MELDIV '
  265. RETURN
  266. 1001 FORMAT(20(1X,I5))
  267. 1002 FORMAT(10(1X,1PE11.4))
  268. END
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  

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