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

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