Télécharger kmf.eso

Retour à la liste

Numérotation des lignes :

  1. C KMF SOURCE PV 16/11/17 21:59:46 9180
  2. SUBROUTINE KMF
  3. C ***********************************************************************
  4. C
  5. C Objet : Cet operateur calcule soit C*U
  6. C soit C*1/D * U
  7. C
  8. C Syntaxe :
  9. C CAS 1 /
  10. C
  11. C B = KMF MATRAK MCHPOI ;
  12. C
  13. C
  14. C CAS 2 /
  15. C
  16. C B = KMF MATRAK MCHPOI 'MDM1' CHPOIMDM1 ;
  17. C ou
  18. C KMF MATRAK MCHPOI 'MDM1' CHPOIMDM1 B ;
  19. C
  20. C Dans ce dernier cas KMF agit comme foncteur sur B
  21. C
  22. C
  23. C
  24. C
  25. C POINTEURS :
  26. C
  27. C MATRAK MATRICES ELEMENTAIRES DE LA DIVERGENCE (ALIAS "C")
  28. C IZTUN CHPOINT CONTENANT U
  29. C
  30. C EN SORTIE :
  31. C
  32. C IZB CONTIENT C*U
  33. C
  34. C ***********************************************************************
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8 (A-H,O-Z)
  37. CHARACTER*8 TYPE,TYPC
  38. -INC CCOPTIO
  39. -INC SMELEME
  40. -INC SMLENTI
  41. POINTEUR IZIPAD.MLENTI
  42. C-INC SMMATRAK
  43. C*************************************************************************
  44. C
  45. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  46. C
  47.  
  48. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  49. * (points CENTRE ) pour chaque operateur de contrainte
  50. * KGEOC SPG pour la totalite des points CENTRE.
  51. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  52. * KLEMC Connectivites de l'ensemble des contraintes
  53. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  54.  
  55. SEGMENT MATRAK
  56. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  57. INTEGER LIZAFM(NBSOUS)
  58. INTEGER IKAM0 (NBSOUS)
  59. INTEGER IMEM (NBELC)
  60. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  61. ENDSEGMENT
  62.  
  63. SEGMENT IZAFM
  64. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  65. ENDSEGMENT
  66.  
  67. POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  68.  
  69. C*******************************************************************
  70. -INC SMCHPOI
  71. POINTEUR IZB.MCHPOI,IZBB.MPOVAL
  72. POINTEUR IZD.MCHPOI,IZDD.MPOVAL
  73. CHARACTER*4 LISMOT(1)
  74. DATA LISMOT/'MDM1'/
  75. C****
  76.  
  77. C LECTURE DES ARGUMENTS
  78.  
  79. CALL QUETYP(TYPE,1,IRET)
  80. IF(IRET.EQ.0) RETURN
  81.  
  82. IF(TYPE.EQ.'MATRIK')THEN
  83. CALL KMFN
  84. RETURN
  85. ELSEIF(TYPE.EQ.'MATRAK')THEN
  86. CALL LIROBJ('MATRAK',MATRAK,1,IRET)
  87.  
  88. CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
  89. IF(IRET.EQ.0) RETURN
  90.  
  91. CALL LIRMOT(LISMOT,1,IMDM1,0)
  92.  
  93. IF(IMDM1.NE.0)THEN
  94. CALL LIROBJ('CHPOINT',IZD,1,IRET)
  95. IF(IRET.EQ.0) RETURN
  96. CALL LICHT(IZD,IZDD,TYPC,IGEOM)
  97. ENDIF
  98.  
  99. SEGACT MATRAK
  100. MELEME=KLEMC
  101. MELEM1=KGEOS
  102. CALL KRIPAD(MELEM1,IZIPAD)
  103. IGEOMC=KGEOC
  104. TYPE='CENTRE'
  105.  
  106.  
  107. IF(IMDM1.EQ.0)THEN
  108. CALL CRCHPT(TYPE,IGEOMC,1,IZB)
  109. CALL LICHT(IZB,IZBB,TYPC,IGEOM)
  110.  
  111. ELSE
  112. CALL LIROBJ('CHPOINT',IZB,0,IRET)
  113.  
  114. IEB=1
  115. IF(IRET.EQ.0) THEN
  116. IEB=0
  117. CALL CRCHPT(TYPE,IGEOMC,1,IZB)
  118. ENDIF
  119.  
  120. CALL LICHT(IZB,IZBB,TYPC,IGEOM)
  121. IF(IGEOM.NE.IGEOMC)THEN
  122. WRITE(6,*)' Le champ de contraintes n a pas le meme support'
  123. &,' geometrique que les matrices de contrainte '
  124. RETURN
  125. ENDIF
  126. ENDIF
  127.  
  128.  
  129. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOU)
  130. N=VPOCHA(/1)
  131.  
  132. SEGACT MELEME
  133. NBSOUS=LISOUS(/1)
  134. IF(NBSOUS.EQ.0)NBSOUS=1
  135. KK=0
  136. DO 15 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.  
  142. NP=IPT1.NUM(/1)
  143. NEL=IPT1.NUM(/2)
  144. IF(IDIM.EQ.3)GO TO 5
  145. C
  146. C 2D
  147. C
  148.  
  149. K0=KK
  150. IF(IMDM1.NE.0)THEN
  151. CALL KRA002(AM,VPOCHA,IZDD.VPOCHA,IZBB.VPOCHA(K0+1,1),
  152. & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
  153. ELSE
  154. CALL KMF2(AM,VPOCHA,IZBB.VPOCHA(K0+1,1),
  155. & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
  156. ENDIF
  157. KK=K0+NEL
  158.  
  159. GO TO 10
  160.  
  161. 5 CONTINUE
  162. C
  163. C 3D
  164. C
  165. K0=KK
  166. IF(IMDM1.NE.0)THEN
  167. CALL KRA003(AM,VPOCHA,IZDD.VPOCHA,IZBB.VPOCHA(K0+1,1),
  168. & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
  169. ELSE
  170. CALL KMF3(AM,VPOCHA,IZBB.VPOCHA(K0+1,1),
  171. & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
  172. ENDIF
  173. KK=K0+NEL
  174.  
  175. 10 CONTINUE
  176. IF(MELEME.NE.IPT1)SEGDES IPT1
  177. SEGDES IZAFM
  178. 15 CONTINUE
  179.  
  180. SEGSUP IZIPAD
  181. SEGDES MELEME
  182. SEGDES MATRAK
  183. SEGACT MCHPOI
  184. MSOUPO=IPCHP(1)
  185. SEGDES MPOVAL
  186. SEGDES MSOUPO
  187. SEGDES MCHPOI
  188. SEGDES IZB,IZBB
  189. IF(IMDM1.NE.0)THEN
  190. SEGDES IZD,IZDD
  191. ENDIF
  192.  
  193. IF(IMDM1.EQ.0.OR.IEB.EQ.0)CALL ECROBJ('CHPOINT ',IZB)
  194. ELSE
  195. RETURN
  196. ENDIF
  197.  
  198. RETURN
  199. END
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  

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