Sources Esope | Cast3M

kmf
C KMF       SOURCE    CB215821  20/11/25    13:31:34     10792          
      SUBROUTINE KMF
C ***********************************************************************
C
C    Objet   :  Cet operateur calcule soit C*U
C                                      soit C*1/D * U
C
C    Syntaxe :
C               CAS 1 /
C
C               B = KMF MATRAK MCHPOI ;
C
C
C               CAS 2 /
C
C               B = KMF  MATRAK MCHPOI 'MDM1' CHPOIMDM1 ;
C      ou
C               KMF  MATRAK MCHPOI 'MDM1' CHPOIMDM1 B ;
C
C    Dans ce dernier cas KMF agit comme foncteur sur B
C
C
C
C
C     POINTEURS :
C
C     MATRAK  MATRICES ELEMENTAIRES DE LA DIVERGENCE (ALIAS "C")
C     IZTUN   CHPOINT CONTENANT U
C
C     EN SORTIE :
C
C     IZB     CONTIENT C*U
C
C ***********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      CHARACTER*8 TYPE,TYPC
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMLENTI
      POINTEUR IZIPAD.MLENTI
C-INC SMMATRAK
C*************************************************************************
C
C    REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES  puis assemblees
C
 
* LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
* (points CENTRE ) pour chaque operateur de contrainte
* KGEOC SPG pour la totalite des points CENTRE.
* KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
* KLEMC Connectivites de l'ensemble des contraintes
* LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
 
      SEGMENT MATRAK
      INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
      INTEGER LIZAFM(NBSOUS)
      INTEGER IKAM0 (NBSOUS)
      INTEGER IMEM  (NBELC)
      INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
      ENDSEGMENT
 
      SEGMENT IZAFM
      REAL*8  AM(NNELP,NP,IESP),RPGI(NELAX)
      ENDSEGMENT
 
      POINTEUR IPMJ.IZAFM,IPMK.IZAFM
 
C*******************************************************************
-INC SMCHPOI
      POINTEUR IZB.MCHPOI,IZBB.MPOVAL
      POINTEUR IZD.MCHPOI,IZDD.MPOVAL
      CHARACTER*4 LISMOT(1)
      DATA LISMOT/'MDM1'/
C****
 
C     LECTURE DES ARGUMENTS
 
      CALL QUETYP(TYPE,1,IRET)
      IF(IRET.EQ.0) RETURN
 
      IF(TYPE.EQ.'MATRIK')THEN
      CALL KMFN
      RETURN
      ELSEIF(TYPE.EQ.'MATRAK')THEN
      CALL LIROBJ('MATRAK',MATRAK,1,IRET)
 
      CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
      IF(IRET.EQ.0) RETURN
 
      CALL LIRMOT(LISMOT,1,IMDM1,0)
 
      IF(IMDM1.NE.0)THEN
      CALL LIROBJ('CHPOINT',IZD,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LICHT(IZD,IZDD,TYPC,IGEOM)
      ENDIF
 
      SEGACT MATRAK
      MELEME=KLEMC
      MELEM1=KGEOS
      CALL KRIPAD(MELEM1,IZIPAD)
      IGEOMC=KGEOC
      TYPE='CENTRE'
 
 
      IF(IMDM1.EQ.0)THEN
      CALL CRCHPT(TYPE,IGEOMC,1,IZB)
      CALL LICHT(IZB,IZBB,TYPC,IGEOM)
 
      ELSE
      CALL LIROBJ('CHPOINT',IZB,0,IRET)
 
      IEB=1
      IF(IRET.EQ.0) THEN
      IEB=0
      CALL CRCHPT(TYPE,IGEOMC,1,IZB)
      ENDIF
 
      CALL LICHT(IZB,IZBB,TYPC,IGEOM)
      IF(IGEOM.NE.IGEOMC)THEN
      WRITE(6,*)' Le champ de contraintes n a pas le meme support'
     &,' geometrique que les matrices de contrainte '
      RETURN
      ENDIF
      ENDIF
 
 
      CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOU)
      N=VPOCHA(/1)
 
      SEGACT MELEME
      NBSOUS=LISOUS(/1)
      IF(NBSOUS.EQ.0)NBSOUS=1
      KK=0
      DO 15 KS=1,NBSOUS
      IF(NBSOUS.EQ.1)IPT1=MELEME
      IF(NBSOUS.NE.1)IPT1=LISOUS(KS)
      IZAFM=LIZAFM(KS)
      SEGACT IPT1,IZAFM
 
      NP=IPT1.NUM(/1)
      NEL=IPT1.NUM(/2)
      IF(IDIM.EQ.3)GO TO 5
C
C                                2D
C
 
      K0=KK
      IF(IMDM1.NE.0)THEN
      CALL KRA002(AM,VPOCHA,IZDD.VPOCHA,IZBB.VPOCHA(K0+1,1),
     & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
      ELSE
      CALL KMF2(AM,VPOCHA,IZBB.VPOCHA(K0+1,1),
     & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
      ENDIF
      KK=K0+NEL
 
      GO TO 10
 
    5 CONTINUE
C
C                                3D
C
      K0=KK
      IF(IMDM1.NE.0)THEN
      CALL KRA003(AM,VPOCHA,IZDD.VPOCHA,IZBB.VPOCHA(K0+1,1),
     & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
      ELSE
      CALL KMF3(AM,VPOCHA,IZBB.VPOCHA(K0+1,1),
     & IPT1.NUM,IZIPAD.LECT,NP,NEL,N)
      ENDIF
      KK=K0+NEL
 
 10   CONTINUE
      IF(MELEME.NE.IPT1)SEGDES IPT1
      SEGDES IZAFM
 15   CONTINUE
 
      SEGSUP IZIPAD
      SEGDES MELEME
      SEGDES MATRAK
      SEGACT MCHPOI
      MSOUPO=IPCHP(1)
      SEGDES MPOVAL
      SEGDES MSOUPO
      SEGDES MCHPOI
      SEGDES IZB,IZBB
      IF(IMDM1.NE.0)THEN
      SEGDES IZD,IZDD
      ENDIF
 
      IF(IMDM1.EQ.0.OR.IEB.EQ.0)CALL ECROBJ('CHPOINT ',IZB)
      ELSE
      RETURN
      ENDIF
 
      RETURN
      END