Sources Esope | Cast3M

rescha
C RESCHA    SOURCE    PV090527  25/01/07    18:18:27     12116          
 
*--------------------------------------------------------------------*
*                                                                    *
*     Restauration des pointeurs issus de la pile des CHAMELEMs.     *
*                                                                    *
*--------------------------------------------------------------------*
      SUBROUTINE RESCHA (ICOLAC,ITLACC,IMAX1,IDEB)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMCHAML
-INC TMCOLAC
      segment iseg(0)
      CHARACTER*8  MOTIP
      CHARACTER*16 NOCOMP
*
*     Boucle sur les CHAMELEMs contenus dans la pile:
*
      ITLAC1 = KCOLA(1)
      ITLAC2 = KCOLA(40)
      ITLAC3 = KCOLA(48)
      ITLAC5 = KCOLA(33)
      DO 10 IEL =IDEB,IMAX1
        MCHELM = ITLAC(IEL)
        IF (MCHELM.EQ.0) GOTO 10
        SEGACT,MCHELM*MOD
        iva = mchelm.mclcnf
        if (abs(iva).le.itlac5.itlac(/1).and.iva.lt.0 ) then
         mchelm.mclcnf= itlac5.itlac(abs(iva))
        endif                                               
        NSOUEL = ICHAML(/1)
        IF (NSOUEL.EQ.0) GOTO 10
        N3 = INFCHE(/2)
        IF (N3.NE.6) THEN
          write(ioimp,*) 'RESCHA : INFCHE(/2) = N3 != 6',mchelm
          call erreur(5)
        ENDIF
        DO 20 ISOU = 1, NSOUEL
          MCHAML = mchelm.ICHAML(ISOU)
          IF (MCHAML.EQ.0) GO TO 20
            SEGACT,MCHAML*MOD
 
            IVA = IMACHE(ISOU)
            IF (IVA.NE.0) IMACHE(ISOU) = ITLAC1.ITLAC(ABS(IVA))
*           IF (IVA.LT.0) IMACHE(ISOU) = ITLAC1.ITLAC(ABS(IVA))
 
            IVA = INFCHE(ISOU,4)
            IF (IVA.LT.0) INFCHE(ISOU,4) = ITLAC2.ITLAC(ABS(IVA))
 
            NCO = TYPCHE(/2)
            DO 30 ICO = 1, NCO
              NOCOMP = TYPCHE(ICO)
              IF (NOCOMP(1:8).EQ.'POINTEUR') THEN
                MELVAL = IELVAL(ICO)
                IF (MELVAL.EQ.0) GOTO 30
                MOTIP(1:8)=NOCOMP(9:16)
                CALL TYPFIL(MOTIP,ITYP)
                IF (ITYP.LE.0) GO TO 30
                ITLAC4 = KCOLA(ITYP)
                SEGACT,MELVAL*MOD
                N1 = IELCHE(/1)
                N2 = IELCHE(/2)
                DO I2 = 1, N2
                  DO I1 = 1, N1
                    IVA = IELCHE(I1,I2)
                    IF (IVA.LT.0) IELCHE(I1,I2) = ITLAC4.ITLAC(ABS(IVA))
                  ENDDO
                ENDDO
                SEGDES,MELVAL
              ELSE
                IVA = IELVAL(ICO)
                IF (IVA.LT.0) IELVAL(ICO) = ITLAC3.ITLAC(ABS(IVA))
              ENDIF
 30         CONTINUE
            SEGDES,MCHAML
 20     CONTINUE
        SEGDES,MCHELM
 10   CONTINUE
 
      RETURN
      END