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

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