Télécharger limmat.eso

Retour à la liste

limmat
C LIMMAT    SOURCE    PV        20/09/26    21:18:38     10724          
      SUBROUTINE LIMMAT (IENTRE,ITLACC,IMAX1,IRET,IFORM)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C=======================================================================
C   BUT        : LECTURE DES MMATRI
C   APPELE PAR : LIPIL
C   APPELLE    : LFCDIM LFCDIE LFCDI2
C   ECRIT PAR FARVACQUE    -REPRIS PAR LENA
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
C=======================================================================
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRI
C
C=======================================================================
      SEGMENT/ITBBM1/( ITABM1(NM))
      SEGMENT/ITLACC/( ITLAC(0))
C
      CHARACTER*4 CPV
      DIMENSION ILENA(15)
C--------------------------------------------------------------------
      IRET=0
      IRETOU=0
      ITBBM1=0
 
C     ***************************** MMATRI *****************************
 
 6016 CONTINUE
 
      DO 2600 IEL=1,IMAX1
         SEGINI MMATRI
         ITLAC(**)=MMATRI
 
C     READ(IENTRE,8000,END=1000,ERR=1000)INC,IGEOMA,IJMAX,INEG,NENS,MAXI,
C    *NNOE,LHAR
 
         IF(IONIVE.LE.8) THEN
             ITOTO = 10
             INSYM =  0
         ELSE
             ITOTO = 11
         ENDIF
         CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 1000
         INC   =   ILENA(1)
         IGEOMA=   ILENA(2)
         IJMAX =   ILENA(3)
         INEG  =   ILENA(4)
         NENS  =   ILENA(5)
         MAXI  =   ILENA(6)
         NNOE  =   ILENA(7)
         LHAR  =   ILENA(8)
         LMIK  =   ILENA(9)
         LDUA  =   ILENA(10)
 
         IF(IONIVE.GE.9) INSYM = ILENA(11)
 
         SEGINI MILIGN
 
         CALL LFCDIE(IENTRE,INC,ITTR,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
 
         CALL LFCDIE(IENTRE,INC,IPNO,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
 
         DO 2601 I=1,NNOE
            ITOTO=7
            CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            NVALL =   ILENA(1)
            NA    =   ILENA(2)
            NBPAR =   ILENA(7)
            SEGINI LIGN
            ILIGN(I)=LIGN
            NA1   =   ILENA(3)
            IMM   =   ILENA(4)
            IPREL =   ILENA(5)
            IDERL =   ILENA(6)
 
            CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM)
            SEGDES LIGN
            IF(IRETOU.NE.0) GOTO 1000
 
 2601    CONTINUE
 
         IILIGN=MILIGN
         SEGDES MILIGN
C
         IF(INSYM.NE.0) THEN
 
            SEGINI MILIGN
 
         DO 26011 I=1,NNOE
            ITOTO=7
            CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            NVALL =   ILENA(1)
            NA    =   ILENA(2)
            NBPAR =   ILENA(7)
            SEGINI LIGN
            ILIGN(I)=LIGN
            NA1   =   ILENA(3)
            IMM   =   ILENA(4)
            IPREL =   ILENA(5)
            IDERL =   ILENA(6)
 
            CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
 
            CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM)
            SEGDES LIGN
            IF(IRETOU.NE.0) GOTO 1000
 
26011    CONTINUE
 
         IILIGS=MILIGN
         SEGDES MILIGN
 
         ENDIF
C
         SEGINI MINCPO
         IINCPO=MINCPO
         L=MAXI*NNOE
         CALL LFCDIE(IENTRE,L,INCPO,IRETOU,IFORM)
         SEGDES MINCPO
         IF(IRETOU.NE.0) GOTO 1000
C
         SEGINI MHARK
         IHARK=MHARK
         DO 2603 I=1,LHAR
            IHAR(**)=0
 2603    CONTINUE
         CALL LFCDIE(IENTRE,LHAR,IHAR(1),IRETOU,IFORM)
         SEGDES MHARK
         IF(IRETOU.NE.0) GOTO 1000
C
         NM=LMIK+LDUA
         SEGINI ITBBM1
         CALL LFCDIM (IENTRE,NM,ITABM1,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 1000
         SEGINI MIMIK
         SEGINI MIDUA
         IIMIK=MIMIK
         IIDUA=MIDUA
         DO 2602 I=1,LMIK
            WRITE (CPV,FMT='(A4)') ITABM1(I)
            IMIK(**)=CPV
 2602    CONTINUE
         DO 2605 I=1,LDUA
            WRITE (CPV,FMT='(A4)') ITABM1(LMIK+I)
            IDUA(**)=CPV
 2605    CONTINUE
         SEGSUP ITBBM1
         SEGDES MIDUA,MIMIK
C
         SEGINI MDNOR
         IDNORM=MDNOR
         CALL LFCDI2(IENTRE,INC,DNOR,IRETOU,IFORM)
         SEGDES MDNOR
         IF(IRETOU.NE.0) GOTO 1000
 
         SEGINI MDIAG
         IDIAG= MDIAG
         CALL LFCDI2(IENTRE,INC,DIAG,IRETOU,IFORM)
         SEGDES MDIAG
         IF(IRETOU.NE.0) GOTO 1000
 
         SEGDES MMATRI
 2600 CONTINUE
      GOTO 1098
 
********************* ON REBOUCLE EN LECTURE **********************
 
 1000 CONTINUE
      IRETOU=1
 1098 CONTINUE
      IRET=IRETOU
      IF (ITBBM1.NE.0) SEGSUP ITBBM1
      RETURN
C -------------------------------------------------------
      END
 
 
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales