Sources Esope | Cast3M

resmak
C RESMAK    SOURCE    PV        17/12/05    21:17:08     9646           
      SUBROUTINE RESMAK (ICOLAC,ITLACC,IMAX1,IDEB)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : RESMAK
C DESCRIPTION : Restauration des pointeurs dans les objets
C               de type MATRAK.
C               (appelé par restpi.eso)
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C SYNTAXE GIBIANE    : -
C ENTREES            : ICOLAC, chapeau sur les piles ITLACC
C                      (une pour chaque type d'objets)
C                      IDEB, IMAX1, indice de début et de fin
C                      sur la pile d'objets MATRAK
C ENTREES/SORTIES    : ITLACC, la pile des objets MATRAK sur
C                      lesquels on va restaurer des pointeurs
C***********************************************************************
C VERSION    : v1, 15/07/98, version initiale
C HISTORIQUE : v1, 15/07/98, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
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
C*************************************************************************
-INC TMCOLAC
C
C     ************************* MATRAK ********************************
C Pile des MELEME
      ITLAC1=KCOLA(1)
C Pile des CHPOINT
      ITLAC2=KCOLA(2)
      DO 1 IEL=IDEB,IMAX1
         MATRAK=ITLAC(IEL)
         IF (MATRAK.EQ.0) THEN
            WRITE(IOIMP,*) 'Failing to save a nil pointer'
            WRITE(IOIMP,*) 'MATRAK type object...'
            GOTO 9999
         ENDIF
         SEGACT MATRAK*MOD
         NBOP=LGEOC(/1)
         IF (NBOP.NE.0)THEN
            DO 605 I=1,NBOP
               IVA=ABS(LGEOC(I))
               IF (IVA.NE.0) LGEOC(I)=ITLAC1.ITLAC(IVA)
 605        CONTINUE
         ENDIF
         IVA=ABS(KLEMC)
         IF (IVA.NE.0) KLEMC=ITLAC1.ITLAC(IVA)
         IVA=ABS(KGEOS)
         IF (IVA.NE.0) KGEOS=ITLAC1.ITLAC(IVA)
         IVA=ABS(KGEOC)
         IF (IVA.NE.0) KGEOC=ITLAC1.ITLAC(IVA)
         IVA=ABS(KDIAG)
         IF (IVA.NE.0) KDIAG=ITLAC2.ITLAC(IVA)
         SEGDES MATRAK
 1    CONTINUE
*
* Normal termination
*
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in subroutine resmak'
      RETURN
*
* End of subroutine RESMAK
*
      END