Sources Esope | Cast3M

kal2p
C KAL2P     SOURCE    CB215821  20/11/25    13:30:45     10792          
      SUBROUTINE KAL2P(MTABP,MCHB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC SMTABLE
      POINTEUR MTABP.MTABLE,MTABX.MTABLE
*-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 SMELEME
-INC SMLMOTS
-INC SMCHPOI
      POINTEUR MPOV1.MPOVAL,IZCH2.MCHPOI,IZCCH2.MPOVAL
      POINTEUR MZQP.MPOVAL
-INC CCREEL
      CHARACTER*8 TYPE,NOMO,NOM
      DIMENSION IXV(3)
C
 
 
      CALL LICHT(MCHB,MPOVAL,TYPE,IGEOM)
 
      TYPE=' '
      CALL ACMO(MTABP,'LISTOPER',TYPE,MLMOTS)
 
      IF(TYPE.NE.'LISTMOTS')THEN
      RETURN
      ENDIF
 
      TYPE=' '
      CALL ACMO(MTABP,'DELTAT',TYPE,IDT)
      IF(TYPE.NE.'FLOTTANT')THEN
      DT=XGRAND
      ELSE
      CALL ACMF(MTABP,'DELTAT',DT)
      ENDIF
 
      TYPE=' '
      CALL ACMO(MTABP,'MATC',TYPE,MATRAK)
      IF(TYPE.NE.'MATRAK')THEN
      WRITE(6,*)' Pb dans KAL2P : table EQPR erronee '
      RETURN
      ENDIF
      SEGACT MATRAK
 
      SEGACT MLMOTS
      NBOP=MOTS(/2)
 
      DO 1 L=1,NBOP
 
      NOMO=MOTS(L)
      IF(L.LT.10)THEN
      NOM=NOMO(2:5)
      ELSE
      NOM=NOMO(3:6)
      ENDIF
 
C     write(6,*)' Second membre NOMO ? ',NOMO
      TYPE=' '
      CALL ACMO(MTABP,NOMO,TYPE,MTABX)
      IF(TYPE.NE.'TABLE')THEN
      WRITE(6,*)' Pb dans KAL2P : table EQPR erronee '
      RETURN
      ENDIF
 
      CALL ACME(MTABX,'IARG',IARG)
      IF(IARG.EQ.0)THEN
C     write(6,*)' pas d''argument pour ',NOMO
      GO TO 1
      ENDIF
 
      TYPE=' '
      CALL ACMO(MTABX,'IZCH2',TYPE,IZCH2)
      IF(TYPE.NE.'CHPOINT ')THEN
      IZCH2=0
      ELSE
      CALL LICHT(IZCH2,IZCCH2,TYPE,IGEOM)
 
C"    nbz=IZCCH2.VPOCHA(/1)
C"    write(6,*)' IZCCH2=',IZCCH2,' NBZ=',nbz
C"    write(6,1002)(IZCCH2.VPOCHA(II,1),ii=1,nbz)
      ENDIF
 
      N1=IDEBS(L)
      N2=IFINS(L)
 
C"    TYPE=' '
C"    CALL ACMO(MTABX,'ARG1',TYPE,ICHP)
C"    IF(TYPE.EQ.'FLOTTANT')THEN
C"    CALL ACMF(MTABX,'ARG1',XVAL)
 
 
      CALL LEKTAB(MTABP,'INCO',KINC)
 
      CALL LEKTAB(MTABX,'DOMZ',MTABZ)
      TYPE=' '
      CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMC)
      TYPE=' '
      CALL ACMO(MTABZ,'SOMMET',TYPE,MELEMS)
 
      IF(NOM.EQ.'PRES    ')THEN
        IXV(1)=MELEMC
        IXV(2)=1
        IXV(3)=0
        IRET  =0
        CALL LEKCOF('Opérateur PRESSION :',
     &              MTABX,KINC,1,IXV,MQP,MZQP,NPT1,NC1,IKQ,IRET)
        IF(IRET.EQ.0)RETURN
      ELSE
        IXV(1)=MELEMS
        IXV(2)=1
        IXV(3)=0
        IRET  =0
        CALL LEKCOF('Opérateur '//NOM//' :',
     &               MTABX,KINC,1,IXV,MQP,MZQP,NPT1,NC1,IKQ,IRET)
      ENDIF
 
C"    IF(IKQ.EQ.1)THEN
C"
C"    XVAL= MZQP.VPOCHA(1,1)
C"
C"    IF(IZCH2.EQ.0)THEN
C"    DO 21 I=N1,N2
C"    VPOCHA(I,1)=VPOCHA(I,1)+XVAL
C21   CONTINUE
C"    ELSE
C"    II=0
C"    DO 22 I=N1,N2
C"    II=II+1
C"    VPOCHA(I,1)=VPOCHA(I,1)+XVAL*IZCCH2.VPOCHA(II,1)/DT
C22   CONTINUE
C"    SEGDES IZCCH2
C"    ENDIF
C"    ELSEIF(IKQ.EQ.0)THEN
C"     CALL LICHT(ICHP,MPOV1,TYPE,IGEOM)
C     write(6,*)' DT=',DT,MZQP.VPOCHA(1,1),' izch2',IZCH2
      IF(IZCH2.EQ.0)THEN
      II=0
      DO 31 I=N1,N2
      II=II+1
      NKQ=1+(1-IKQ)*(II-1)
C     VPOCHA(I,1)=VPOCHA(I,1)+MZQP.VPOCHA(NKQ,1)/(DT*.0.9)
      VPOCHA(I,1)=VPOCHA(I,1)+MZQP.VPOCHA(NKQ,1)/DT
 31   CONTINUE
      ELSE
      II=0
      DO 32 I=N1,N2
      II=II+1
      NKQ=1+(1-IKQ)*(II-1)
      VPOCHA(I,1)=VPOCHA(I,1)+
C    &MZQP.VPOCHA(NKQ,1)*IZCCH2.VPOCHA(II,1)
     &MZQP.VPOCHA(NKQ,1)*IZCCH2.VPOCHA(II,1)/DT
 32   CONTINUE
      SEGDES IZCCH2
      ENDIF
      SEGDES MZQP
 
C"    ELSE
C"    write(6,*)' On ne fera pas'
C"    ENDIF
 
 1    CONTINUE
      SEGDES MLMOTS,MATRAK,MPOVAL
 
      RETURN
 1001 FORMAT(20(1X,I5))
 1002 FORMAT(10(1X,1PE11.4))
      END