Sources Esope | Cast3M

kmtp
C KMTP      SOURCE    CB215821  20/11/25    13:31:41     10792          
      SUBROUTINE KMTP
C************************************************************************
C              T
C   CALCUL DE C P
C
C     MCHPOI = KMTP MATRAK IZB ;
C
C     POINTEURS :
C
C     MATRAK  MATRICES ELEMENTAIRES DE LA DIVERGENCE (ALIAS "C")
C     IZB     CHAMP DE PRESSION (SCAL ELEM SUR LA ZONE PRESSION)
C     MELEME  OBJET MAILLAGE SUR LEQUEL REPOSE LA PRESSION
C     IZIPAD  CORRESPONDANCE NUMER. GLOBALE --> NUMER. LOCALE
C             (DOMAINE SUR LEQUEL PORTE AP ET NON LA PRESSION)
C     MELEMG  OBJET MAILLAGE SUR LEQUEL REPOSE LE GRADIENT DE PRESSION
C             C'EST UN OBJET MAILLAGE COMPOSE DE POI1.
C
C !!!!!!!!!!! QUI DOIT ETRE LE CHANGER MELEME POI1 !!!!!!!!!!!!!!!!!!!!
C !!!!!!!!!!! ON NE VERIFIE MEME PAS (SCANDALEUX)  !!!!!!!!!!!!!!!!!!!!
C
C     EN SORTIE :
C                                                 T
C     MCHPOI  CONTIENT LE GRADIENT DE PRESSION C P
C
C ***********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      CHARACTER*8 TYPE,TYPC
      CHARACTER*4 NOM4(3)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
      POINTEUR MELEMG.MELEME
-INC SMLENTI
      POINTEUR IZIPAD.MLENTI
-INC SMLMOTS
C-INC SMMATRAKANC
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
C***
C     write(6,*)' DEBUT KMTP '
      CALL QUETYP(TYPE,0,IRET)
      IF(TYPE.EQ.'ENTIER')THEN
      CALL LIRENT(NASTOK,0,IRET)
      ELSE
      NASTOK=0
      ENDIF
       IF(NASTOK.EQ.0)THEN
       CALL ZKMTP
       RETURN
       ENDIF
 
      TYPE='MATRAK'
      CALL LIROBJ(TYPE,MATRAK,1,IRET)
      IF(IRET.EQ.0)RETURN
 
      TYPE='CHPOINT '
      CALL LIROBJ(TYPE,IZB,1,IRET)
      IF(IRET.EQ.0)RETURN
      CALL LICHT(IZB,IZBB,TYPC,IGEOMC)
 
      CALL LIROBJ(TYPE,IZV,0,IRET)
      IF(IRET.EQ.0)IZV=0
 
      CALL LIROBJ('LISTMOTS',MLMOTS,1,IRET)
      IF(IRET.EQ.0)RETURN
      SEGACT MLMOTS
      JGM=MOTS(/2)
      DO 178 I=1,JGM
      NOM4(I)=MOTS(I)
 178  CONTINUE
      SEGDES MLMOTS
 
      SEGACT MATRAK
      MELEME=KLEMC
 
      MELEMG=KGEOS
      CALL KRIPAD(MELEMG,IZIPAD)
      NC=IDIM
      TYPE='SOMMET'
      IF(IZV.EQ.0)THEN
      CALL KRCHPT(TYPE,MELEMG,NC,MCHPOI,NOM4)
      CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOMS)
      NPT=VPOCHA(/1)
      ELSE
      CALL LICHT(IZV,IZVV,TYPC,IGEOMS)
      IF(IGEOMS.NE.MELEMG)THEN
      WRITE(6,*)'Supports geometriques non compatibles'
      RETURN
      ENDIF
      MCHPOI=0
      MPOVAL=IZVV
      NPT=VPOCHA(/1)
      IF(VPOCHA(/2).NE.IDIM)THEN
      WRITE(6,*)' Champoint inacceptable '
      RETURN
      ENDIF
 
      ENDIF
 
      SEGACT MELEME
 
 
 
      NBSOUS=LISOUS(/1)
      IF(NBSOUS.EQ.0)NBSOUS=1
      KK=0
 
      DO 13 KS=1,NBSOUS
      IF(NBSOUS.EQ.1)IPT1=MELEME
      IF(NBSOUS.NE.1)IPT1=LISOUS(KS)
      IZAFM=LIZAFM(KS)
      SEGACT IPT1,IZAFM
C
C
      NP=IPT1.NUM(/1)
      NEL=IPT1.NUM(/2)
C
      IF(IDIM.EQ.3)GO TO 5
C
C*******************************************************************
C PARTIE NUMERIQUE 2D DANS CMP2
C*******************************************************************
C
      K0=KK
      CALL KMP2(AM,IZBB.VPOCHA(K0+1,1),VPOCHA,
     & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT)
      KK=K0+NEL
 
C     DO 6 K=1,NEL
C     KK=KK+1
C     DO 7 I=1,NP
C     IU=IPADL(IPT1.NUM(I,K))
C     VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK)
C     VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK)
C7    CONTINUE
C6    CONTINUE
 
      GO TO 10
 
 5    CONTINUE
 
C
C*******************************************************************
C PARTIE NUMERIQUE 3D DANS CMP3
C*******************************************************************
C
      K0=KK
      CALL KMP3(AM,IZBB.VPOCHA(K0+1,1),VPOCHA,
     & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT)
      KK=K0+NEL
 
C     DO 11 K=1,NEL
C     KK=KK+1
C     DO 12 I=1,NP
C     IU=IPADL(IPT1.NUM(I,K))
C     VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK)
C     VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK)
C     VPOCHA(IU,3)=VPOCHA(IU,3)+AM(K,I,1)*B(KK)
C12   CONTINUE
C11   CONTINUE
 
 10   CONTINUE
      SEGDES IPT1
      SEGDES IZAFM
 13   CONTINUE
 
      SEGSUP IZIPAD
      SEGDES MELEME
      SEGDES IZB,IZBB
 
      SEGDES MPOVAL
      SEGDES MATRAK
 
      IF(MCHPOI.NE.0)CALL ECROBJ('CHPOINT',MCHPOI)
C     write(6,*)' FIN KMTP '
      RETURN
      END