Sources Esope | Cast3M

limtak
C LIMTAK    SOURCE    PV        17/12/05    21:16:29     9646           
      SUBROUTINE LIMTAK(IFRES,ITLACC,IMAX1,IRET,IFORM)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C***********************************************************************
C NOM         : LIMTAK
C DESCRIPTION : Lecture d'un objet de type MATRAK sur le
C               fichier IFRES
C               (appelé par lipil.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 APPELES (E/S)    : LFCDIE (lecture d'un tableau d'entiers)
C                    LFCDI2 (lecture d'un tableau de REAL*8)
C***********************************************************************
C SYNTAXE GIBIANE    : RESTITUER
C ENTREES            : IFRES, numéro du fichier de lecture
C                      IMAX1, nombre d'objets MATRAK à lire
C                      IFORM, le fichier à lire est formaté ou
C                             non.
C ENTREES/SORTIES    : ITLACC, la pile des objets MATRAK à
C                      laquelle on ajoute les objets lus
C CODE RETOUR (IRET) : 0, ok
C                      1, erreur dans la lecture de l'objet
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 SMMATRK1
-INC TMCOLAC
      SEGMENT IZA
      REAL*8 A(NBVA)
      ENDSEGMENT
C
      INTEGER NDTAB
      INTEGER IEL,I
      INTEGER ILENA(7)
C======================================================================
*
* Executable statements
*
      IRET=0
      IRETOU=0
C ... BOUCLE SUR LES MATRAK DE LA PILE
      DO 1 IEL=1,IMAX1
C     Restitution du chapeau
         MATRAK=0
C       Dimensions
         NDTAB=3
         CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         NBOP  =ILENA(1)
         NBSOUS=ILENA(2)
         NBELC =ILENA(3)
         SEGINI MATRAK
C       Rigidités élémentaires
         NDTAB = NBOP
         CALL LFCDIE(IFRES,NDTAB,LGEOC,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         NDTAB = NBOP
         CALL LFCDIE(IFRES,NDTAB,IDEBS,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         NDTAB = NBOP
         CALL LFCDIE(IFRES,NDTAB,IFINS,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         NDTAB = NBSOUS
         CALL LFCDIE(IFRES,NDTAB,LIZAFM,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         NDTAB = NBSOUS
         CALL LFCDIE(IFRES,NDTAB,IKAM0,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         NDTAB = NBELC
         CALL LFCDIE(IFRES,NDTAB,IMEM,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         NDTAB = 7
         CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 9999
         KLEMC=ILENA( 1)
         KGEOS=ILENA( 2)
         KGEOC=ILENA( 3)
         KDIAG=ILENA( 4)
         KCAC =ILENA( 5)
         KIZCL=ILENA( 6)
         KIZGC=ILENA( 7)
C     Restitution des IZAFM
         DO 11 I=1,NBSOUS
            IZAFM=LIZAFM(I)
            IF (IZAFM.NE.0) THEN
               NDTAB=4
               CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
               IF (IRETOU.NE.0) GOTO 9999
               NNELP=ILENA(1)
               NP   =ILENA(2)
               IESP =ILENA(3)
               NELAX=ILENA(4)
               SEGINI IZAFM
               NDTAB=NNELP*NP*IESP
               CALL LFCDI2(IFRES,NDTAB,AM,IRETOU,IFORM)
               IF (IRETOU.NE.0) GOTO 9999
               NDTAB=NELAX
               CALL LFCDI2(IFRES,NDTAB,RPGI,IRETOU,IFORM)
               IF (IRETOU.NE.0) GOTO 9999
               SEGDES IZAFM
               LIZAFM(I)=IZAFM
            ENDIF
 11      CONTINUE
C     Restitution du IZL
         IF (KIZCL.NE.0) THEN
C       Dimensions
            NDTAB=4
            CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 9999
            NJA =ILENA(1)
            NJAN=ILENA(2)
            NJAB=ILENA(3)
            SEGINI IZL
            KZA1=ILENA(4)
C       Contenu des tableaux
            NDTAB=NJA
            CALL LFCDIE(IFRES,NDTAB,KZA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 9999
            NDTAB=NJAN
            CALL LFCDIE(IFRES,NDTAB,NUAN,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 9999
            NDTAB=NJAN
            CALL LFCDIE(IFRES,NDTAB,NUNA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 9999
            NDTAB=NJAN
            CALL LFCDIE(IFRES,NDTAB,IMEL,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 9999
            NDTAB=NJAN
            CALL LFCDIE(IFRES,NDTAB,IMJ,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 9999
            NDTAB=NJAB
            CALL LFCDI2(IFRES,NDTAB,B,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 9999
C        Restitution du IDMAT
            IF (KZA1.NE.0) THEN
C         Dimension
               NDTAB=2
               CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
               IF (IRETOU.NE.0) GOTO 9999
               NBLK =ILENA(1)
               SEGINI IDMAT
               IDIAG=ILENA(2)
               NDTAB=NBLK
               CALL LFCDIE(IFRES,NDTAB,IDESCR,IRETOU,IFORM)
               IF (IRETOU.NE.0) GOTO 9999
               NDTAB=NBLK+1
               CALL LFCDIE(IFRES,NDTAB,NLDBLK,IRETOU,IFORM)
               IF (IRETOU.NE.0) GOTO 9999
               IF (IDIAG.NE.0) THEN
                  NDTAB=1
                  CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
                  IF (IRETOU.NE.0) GOTO 9999
                  NBVA=ILENA(1)
                  SEGINI IZA
                  NDTAB=NBVA
                  CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM)
                  IF (IRETOU.NE.0) GOTO 9999
                  SEGDES IZA
                  IDIAG=IZA
               ENDIF
C        Restitution des IDBLK
               DO 211 INBLK=1,NBLK
                  IDBLK=IDESCR(INBLK)
                  IF (IDBLK.NE.0) THEN
C           Dimension
                     NDTAB=3
                     CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
                     IF (IRETOU.NE.0) GOTO 9999
                     NLBLK=ILENA(1)
                     SEGINI IDBLK
                     IMAT =ILENA(2)
                     ILON =ILENA(3)
                     NDTAB=NLBLK+1
                     CALL LFCDIE(IFRES,NDTAB,IDEBLK,IRETOU,IFORM)
                     IF (IRETOU.NE.0) GOTO 9999
                     IF (IMAT.NE.0) THEN
                        NDTAB=1
                        CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
                        IF (IRETOU.NE.0) GOTO 9999
                        NBVA=ILENA(1)
                        SEGINI IZA
                        NDTAB=NBVA
                        CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM)
                        IF (IRETOU.NE.0) GOTO 9999
                        SEGDES IZA
                        IMAT=IZA
                     ENDIF
                     SEGDES IDBLK
                     IDESCR(INBLK)=IDBLK
                  ENDIF
 211           CONTINUE
               SEGDES IDMAT
               KZA1=IDMAT
            ENDIF
            SEGDES IZL
            KIZCL=IZL
         ENDIF
         SEGDES MATRAK
         ITLAC(**)=MATRAK
 1    CONTINUE
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in subroutine limtak'
      IRET=1
      RETURN
*
* End of subroutine LIMTAK
*
      END