Sources Esope | Cast3M

examtk
C EXAMTK    SOURCE    PV        21/01/21    21:15:18     10862          
      SUBROUTINE EXAMTK (ICOLAC,ITLACC,M1,M2,IIICHA)
C----------------------------------------------------------------------
C
C  BUT:  REMPLIT LES PILES A PARTIR DE L EXAMEN DES MATRAK
C        SI IIICHA =1 ON  CHANGE  LES POINTEURS----
C completement pompe sur exachp
C
C     ENTREE ITLACC POINTEUR DE LA PILE EXAMINEE
C            ICOLAC POINTEUR SUR LE CHAPEAU DES PILES
C            M1     @REMIER INDICE D EXAMEN DANS LA PILE
C            M2     DERNIER INDICE
C            IIICHA =1 ON CHANGE LES POINTEURS
C----------------------------------------------------------------
C   APPELE PAR EXPIL
C   APPELLE AJOUN
C
C=======================================================================
C  TABLEAU KCOLA :
C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6
C    7          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER
C=======================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
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*******************************************************************
      POINTEUR IVA.MELEME
 
-INC PPARAM
-INC CCOPTIO
-INC TMCOLAC
      iun=1
      ICO1=KCOLA(1)
      ICO2=KCOLA(2)
      ILISSE=ILISSG
      SEGACT ILISSE*MOD
      DO 604 IEL=M1,M2
         MATRAK=ITLAC(IEL)
         IF (MATRAK.EQ.0) GO TO 604
         SEGACT MATRAK*MOD
         NBOP=LGEOC(/1)
         IF (NBOP.NE.0)THEN
            DO 605 I=1,NBOP
               IVA=LGEOC(I)
               IF (IVA.GT.0) THEN
                  SEGDES IVA
                  CALL AJOUN(ICO1,IVA,ILISSE,iun)
                  IF(IIICHA.EQ.1) LGEOC(I) =-IVA
               ENDIF
 605        CONTINUE
         ENDIF
         IVA=KLEMC
         IF (IVA.GT.0) THEN
            SEGDES IVA
            CALL AJOUN(ICO1,IVA,ILISSE,iun)
            IF(IIICHA.EQ.1) KLEMC =-IVA
         ENDIF
         IVA=KGEOS
         IF (IVA.GT.0) THEN
            SEGDES IVA
            CALL AJOUN(ICO1,IVA,ILISSE,iun)
            IF(IIICHA.EQ.1) KGEOS =-IVA
         ENDIF
         IVA=KGEOC
         IF (IVA.GT.0) THEN
            SEGDES IVA
            CALL AJOUN(ICO1,IVA,ILISSE,iun)
            IF(IIICHA.EQ.1) KGEOC =-IVA
         ENDIF
         IVA=KDIAG
         IF (IVA.GT.0) THEN
            SEGDES IVA
            CALL AJOUN(ICO2,IVA,ILISSE,iun)
            IF(IIICHA.EQ.1) KDIAG =-IVA
         ENDIF
         SEGDES MATRAK
 604  CONTINUE
*      SEGDES ILISSE
      RETURN
C     ************
      END