Sources Esope | Cast3M

resimo
C RESIMO    SOURCE    OF166741  24/12/18    21:15:30     12090          
 
*--------------------------------------------------------------------*
*                                                                    *
*     Restauration d'un pointeur IMODEL                              *
*                                                                    *
*--------------------------------------------------------------------*
 
      SUBROUTINE RESIMO (ICOLAC,IMODEL,NIVEAU)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMMODEL
 
-INC TMCOLAC
 
      EXTERNAL LONG
      CHARACTER*(8) ityp1,MOTa
      CHARACTER*(lOCHAI) m_libe,m_mode
      LOGICAL b_z
 
c-dbg      write(ioimp,*) 'ENTREE DANS RESIMO :',IMODEL
 
      ITLAC1 = icolac.KCOLA(1)
      ITLAC2 = icolac.KCOLA(10)
      ITLAC3 = icolac.KCOLA(40)
      ITLAC4 = icolac.KCOLA(29)
 
      SEGACT,IMODEL*MOD
 
      NFOR   = imodel.FORMOD(/2)
      NMAT   = imodel.MATMOD(/2)
      MN3    = imodel.INFMOD(/1)
      NOBMOD = imodel.IVAMOD(/1)
 
C* Cas Bizarre NFOR=0 !
      if (NFOR.eq.0) then
        write(ioimp,*) 'RESIMO : NFOR = 0 !'
        call erreur(5)
      endif
      if (MN3.lt.1) then
        write(ioimp,*) 'RESMMO : MN3 = INFMOD(/1) &lt; 1'
        call erreur(5)
      endif
 
      IVA = imodel.IMAMOD
      IF (IVA.LT.0) imodel.IMAMOD = ITLAC1.ITLAC(ABS(IVA))
 
C  Point support DEFO.GENE.
      IVA = imodel.IPDPGE
      IF (IVA.LT.0) imodel.IPDPGE = ITLAC1.ITLAC(ABS(IVA))
 
C  Dans le cas 'MECANIQUE_DES_FLUIDES' : INFMOD(2) contient une table
      IF (MN3.GT.1) THEN
        IVA = imodel.INFMOD(2)
        IF (IVA.LT.0) imodel.INFMOD(2) = ITLAC2.ITLAC(ABS(IVA))
      ENDIF
 
      DO io = 3, MN3
        if (io.ne.9.and.io.ne.13) then
          iva = imodel.INFMOD(io)
          IF (iva.LT.0) THEn
            if (io.eq.14) then
              imodel.INFMOD(io) = ITLAC4.ITLAC(ABS(iva))
            else
              imodel.INFMOD(io) = ITLAC3.ITLAC(ABS(iva))
            endif
          ENDIF
        endif
      ENDDO
 
      DO io = 1, NOBMOD
        ityp1 = imodel.tymode(io)
        CALL TYPFIL(ityp1,j)
        if (j.gt.0) then
          itlac5 = icolac.KCOLA(j)
          iva = imodel.ivamod(io)
          if (iva.lt.0) imodel.ivamod(io) = itlac5.itlac(abs(iva))
        endif
      ENDDO
 
      if (NFOR.eq.1) then
        if (NOBMOD.eq.0) goto 200
        if (imodel.INATUU.ge.0) goto 200
 
        noblib = 0
        DO io = 1, NOBMOD
          IF (imodel.TYMODE(io).EQ.'MOT   ') THEN
            iva = imodel.IVAMOD(io)
            CALL QUEVAL(iva,'MOT     ',ier,lgmot,r_z,MOTa,b_z,i_z)
            IF (ier.NE.0) CALL ERREUR(5)
            IF (MOTa.EQ.'LMEEXT  ' .AND.
     &          (imodel.formod(1).EQ.'MECANIQUE       '.OR.
     &           imodel.formod(1).EQ.'POREUX          ')   ) THEN
              noblib = io+1
              imoLib = imodel.ivamod(io+2)
              imoFct = imodel.ivamod(io+3)
              GOTO 220
            ELSE IF (MOTa.EQ.'LDIEXT  ' .AND.
     &               imodel.FORMOD(1).EQ.'DIFFUSION       ') THEN
              noblib = io+1
              imoLib = imodel.ivamod(io+2)
              imoFct = imodel.ivamod(io+3)
              GOTO 220
            ENDIF
          ENDIF
        ENDDO
 220    CONTINUE
        IF (noblib.LE.0) GOTO 200
 
        CALL QUEVAL(imoLib,'MOT',ier,lli,r_z,m_libe,b_z,i_z)
        IF (ier .NE. 0) CALL ERREUR(5)
        CALL QUEVAL(imoFct,'MOT',ier,lmo,r_z,m_mode,b_z,i_z)
        IF (ier .NE. 0) CALL ERREUR(5)
        imodel.ivamod(noblib) = 0
        i_z = -1
        CALL LEXTOP(m_libe,m_mode,i_z,m_iloi,m_ptre)
        if (m_iloi.gt.0) imodel.ivamod(noblib) = m_ptre
        lli = LONG(m_libe)
        CALL POSCHA(m_libe(1:lli),imoLib)
        imodel.ivamod(noblib+1) = imoLib
        lmo = LONG(m_mode)
        CALL POSCHA(m_mode(1:lmo),imoFct)
        imodel.ivamod(noblib+2) = imoFct
 
 200    continue
      endif
 
      SEGDES,IMODEL
 
      RETURN
      END