Télécharger kmtp.eso

Retour à la liste

Numérotation des lignes :

  1. C KMTP SOURCE PV 16/11/17 21:59:50 9180
  2. SUBROUTINE KMTP
  3. C************************************************************************
  4. C T
  5. C CALCUL DE C P
  6. C
  7. C MCHPOI = KMTP MATRAK IZB ;
  8. C
  9. C POINTEURS :
  10. C
  11. C MATRAK MATRICES ELEMENTAIRES DE LA DIVERGENCE (ALIAS "C")
  12. C IZB CHAMP DE PRESSION (SCAL ELEM SUR LA ZONE PRESSION)
  13. C MELEME OBJET MAILLAGE SUR LEQUEL REPOSE LA PRESSION
  14. C IZIPAD CORRESPONDANCE NUMER. GLOBALE --> NUMER. LOCALE
  15. C (DOMAINE SUR LEQUEL PORTE AP ET NON LA PRESSION)
  16. C MELEMG OBJET MAILLAGE SUR LEQUEL REPOSE LE GRADIENT DE PRESSION
  17. C C'EST UN OBJET MAILLAGE COMPOSE DE POI1.
  18. C
  19. C !!!!!!!!!!! QUI DOIT ETRE LE CHANGER MELEME POI1 !!!!!!!!!!!!!!!!!!!!
  20. C !!!!!!!!!!! ON NE VERIFIE MEME PAS (SCANDALEUX) !!!!!!!!!!!!!!!!!!!!
  21. C
  22. C EN SORTIE :
  23. C T
  24. C MCHPOI CONTIENT LE GRADIENT DE PRESSION C P
  25. C
  26. C ***********************************************************************
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (A-H,O-Z)
  29. CHARACTER*8 TYPE,TYPC
  30. CHARACTER*4 NOM4(3)
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMELEME
  35. POINTEUR MELEMG.MELEME
  36. -INC SMLENTI
  37. POINTEUR IZIPAD.MLENTI
  38. -INC SMLMOTS
  39. C-INC SMMATRAKANC
  40. C*************************************************************************
  41. C
  42. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  43. C
  44.  
  45. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  46. * (points CENTRE ) pour chaque operateur de contrainte
  47. * KGEOC SPG pour la totalite des points CENTRE.
  48. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  49. * KLEMC Connectivites de l'ensemble des contraintes
  50. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  51.  
  52. SEGMENT MATRAK
  53. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  54. INTEGER LIZAFM(NBSOUS)
  55. INTEGER IKAM0 (NBSOUS)
  56. INTEGER IMEM (NBELC)
  57. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  58. ENDSEGMENT
  59.  
  60. SEGMENT IZAFM
  61. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  62. ENDSEGMENT
  63.  
  64. POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  65.  
  66. C*******************************************************************
  67. -INC SMCHPOI
  68. POINTEUR IZB.MCHPOI,IZBB.MPOVAL
  69. C***
  70. C write(6,*)' DEBUT KMTP '
  71. CALL QUETYP(TYPE,0,IRET)
  72. IF(TYPE.EQ.'ENTIER')THEN
  73. CALL LIRENT(NASTOK,0,IRET)
  74. ELSE
  75. NASTOK=0
  76. ENDIF
  77. IF(NASTOK.EQ.0)THEN
  78. CALL ZKMTP
  79. RETURN
  80. ENDIF
  81.  
  82. TYPE='MATRAK'
  83. CALL LIROBJ(TYPE,MATRAK,1,IRET)
  84. IF(IRET.EQ.0)RETURN
  85.  
  86. TYPE='CHPOINT '
  87. CALL LIROBJ(TYPE,IZB,1,IRET)
  88. IF(IRET.EQ.0)RETURN
  89. CALL LICHT(IZB,IZBB,TYPC,IGEOMC)
  90.  
  91. CALL LIROBJ(TYPE,IZV,0,IRET)
  92. IF(IRET.EQ.0)IZV=0
  93.  
  94. CALL LIROBJ('LISTMOTS',MLMOTS,1,IRET)
  95. IF(IRET.EQ.0)RETURN
  96. SEGACT MLMOTS
  97. JGM=MOTS(/2)
  98. DO 178 I=1,JGM
  99. NOM4(I)=MOTS(I)
  100. 178 CONTINUE
  101. SEGDES MLMOTS
  102.  
  103. SEGACT MATRAK
  104. MELEME=KLEMC
  105.  
  106. MELEMG=KGEOS
  107. CALL KRIPAD(MELEMG,IZIPAD)
  108. NC=IDIM
  109. TYPE='SOMMET'
  110. IF(IZV.EQ.0)THEN
  111. CALL KRCHPT(TYPE,MELEMG,NC,MCHPOI,NOM4)
  112. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOMS)
  113. NPT=VPOCHA(/1)
  114. ELSE
  115. CALL LICHT(IZV,IZVV,TYPC,IGEOMS)
  116. IF(IGEOMS.NE.MELEMG)THEN
  117. WRITE(6,*)'Supports geometriques non compatibles'
  118. RETURN
  119. ENDIF
  120. MCHPOI=0
  121. MPOVAL=IZVV
  122. NPT=VPOCHA(/1)
  123. IF(VPOCHA(/2).NE.IDIM)THEN
  124. WRITE(6,*)' Champoint inacceptable '
  125. RETURN
  126. ENDIF
  127.  
  128. ENDIF
  129.  
  130. SEGACT MELEME
  131.  
  132.  
  133.  
  134. NBSOUS=LISOUS(/1)
  135. IF(NBSOUS.EQ.0)NBSOUS=1
  136. KK=0
  137.  
  138. DO 13 KS=1,NBSOUS
  139. IF(NBSOUS.EQ.1)IPT1=MELEME
  140. IF(NBSOUS.NE.1)IPT1=LISOUS(KS)
  141. IZAFM=LIZAFM(KS)
  142. SEGACT IPT1,IZAFM
  143. C
  144. C
  145. NP=IPT1.NUM(/1)
  146. NEL=IPT1.NUM(/2)
  147. C
  148. IF(IDIM.EQ.3)GO TO 5
  149. C
  150. C*******************************************************************
  151. C PARTIE NUMERIQUE 2D DANS CMP2
  152. C*******************************************************************
  153. C
  154. K0=KK
  155. CALL KMP2(AM,IZBB.VPOCHA(K0+1,1),VPOCHA,
  156. & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT)
  157. KK=K0+NEL
  158.  
  159. C DO 6 K=1,NEL
  160. C KK=KK+1
  161. C DO 7 I=1,NP
  162. C IU=IPADL(IPT1.NUM(I,K))
  163. C VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK)
  164. C VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK)
  165. C7 CONTINUE
  166. C6 CONTINUE
  167.  
  168. GO TO 10
  169.  
  170. 5 CONTINUE
  171.  
  172. C
  173. C*******************************************************************
  174. C PARTIE NUMERIQUE 3D DANS CMP3
  175. C*******************************************************************
  176. C
  177. K0=KK
  178. CALL KMP3(AM,IZBB.VPOCHA(K0+1,1),VPOCHA,
  179. & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT)
  180. KK=K0+NEL
  181.  
  182. C DO 11 K=1,NEL
  183. C KK=KK+1
  184. C DO 12 I=1,NP
  185. C IU=IPADL(IPT1.NUM(I,K))
  186. C VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK)
  187. C VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK)
  188. C VPOCHA(IU,3)=VPOCHA(IU,3)+AM(K,I,1)*B(KK)
  189. C12 CONTINUE
  190. C11 CONTINUE
  191.  
  192. 10 CONTINUE
  193. SEGDES IPT1
  194. SEGDES IZAFM
  195. 13 CONTINUE
  196.  
  197. SEGSUP IZIPAD
  198. SEGDES MELEME
  199. SEGDES IZB,IZBB
  200.  
  201. SEGDES MPOVAL
  202. SEGDES MATRAK
  203.  
  204. IF(MCHPOI.NE.0)CALL ECROBJ('CHPOINT',MCHPOI)
  205. C write(6,*)' FIN KMTP '
  206. RETURN
  207. END
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  

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