Télécharger la plaquette Cast3M


fr en

Télécharger resimo.eso

Retour à la liste

Numérotation des lignes : 

resimo

  1. C RESIMO    SOURCE    OF166741  25/10/03    21:15:05     12350          
  2.  
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *     Restauration d'un pointeur IMODEL                              *
  6. *                                                                    *
  7. *--------------------------------------------------------------------*
  8.  
  9.       SUBROUTINE RESIMO (ICOLAC,IMODEL,NIVEAU)
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16.  
  17. -INC SMMODEL
  18.  
  19. -INC TMCOLAC
  20.  
  21.       EXTERNAL LONG
  22.       CHARACTER*(8) ityp1,MOTa
  23.       CHARACTER*(lOCHAI) m_libe,m_mode
  24.       LOGICAL b_z
  25.  
  26. c-dbg      write(ioimp,*) 'ENTREE DANS RESIMO :',IMODEL
  27.  
  28.       ITLAC1 = icolac.KCOLA(1)
  29.       ITLAC2 = icolac.KCOLA(10)
  30.       ITLAC3 = icolac.KCOLA(40)
  31.       ITLAC4 = icolac.KCOLA(29)
  32.  
  33.       SEGACT,IMODEL*MOD
  34.  
  35.       NFOR   = imodel.FORMOD(/2)
  36.       NMAT   = imodel.MATMOD(/2)
  37.       MN3    = imodel.INFMOD(/1)
  38.       NOBMOD = imodel.IVAMOD(/1)
  39.  
  40. C* Cas Bizarre NFOR=0 !
  41.       if (NFOR.eq.0) then
  42.         write(ioimp,*) 'RESIMO : NFOR = 0 !'
  43.         call erreur(5)
  44.       endif
  45.       if (MN3.lt.1) then
  46.         write(ioimp,*) 'RESMMO : MN3 = INFMOD(/1) < 1'
  47.         call erreur(5)
  48.       endif
  49.  
  50.       IVA = imodel.IMAMOD
  51.       IF (IVA.LT.0) imodel.IMAMOD = ITLAC1.ITLAC(ABS(IVA))
  52.  
  53. C  Point support DEFO.GENE.
  54.       IVA = imodel.IPDPGE
  55.       IF (IVA.LT.0) imodel.IPDPGE = ITLAC1.ITLAC(ABS(IVA))
  56.  
  57. C  Dans le cas 'MECANIQUE_DES_FLUIDES' : INFMOD(2) contient une table
  58.       IF (MN3.GT.1) THEN
  59.         IVA = imodel.INFMOD(2)
  60.         IF (IVA.LT.0) imodel.INFMOD(2) = ITLAC2.ITLAC(ABS(IVA))
  61.       ENDIF
  62.  
  63.       DO io = 3, MN3
  64.         if (io.ne.9.and.io.ne.13) then
  65.           iva = imodel.INFMOD(io)
  66.           IF (iva.LT.0) THEn
  67.             if (io.eq.14) then
  68.               imodel.INFMOD(io) = ITLAC4.ITLAC(ABS(iva))
  69.             else
  70.               imodel.INFMOD(io) = ITLAC3.ITLAC(ABS(iva))
  71.             endif
  72.           ENDIF
  73.         endif
  74.       ENDDO
  75.  
  76.       DO io = 1, NOBMOD
  77.         ityp1 = imodel.tymode(io)
  78.         CALL TYPFIL(ityp1,j)
  79.         if (j.gt.0) then
  80.           itlac5 = icolac.KCOLA(j)
  81.           iva = imodel.ivamod(io)
  82.           if (iva.lt.0) imodel.ivamod(io) = itlac5.itlac(abs(iva))
  83.         endif
  84.       ENDDO
  85.  
  86.       if (NFOR.eq.1) then
  87.         if (NOBMOD.eq.0) goto 200
  88.         if (imodel.INATUU.ge.0) goto 200
  89.  
  90.         noblib = 0
  91.         DO io = 1, NOBMOD
  92.           IF (imodel.TYMODE(io).EQ.'MOT   ') THEN
  93.             iva = imodel.IVAMOD(io)
  94.             CALL QUEVAL(iva,'MOT     ',ier,lgmot,r_z,MOTa,b_z,i_z)
  95.             IF (ier.NE.0) CALL ERREUR(5)
  96. c* Anciens "niveaux" de sauvegarde :
  97.             IF (MOTa.EQ.'LMEEXT  ' .OR. MOTa.EQ.'LDIEXT  ') THEN
  98.               MOTa = 'LOIEXT  '
  99.             ENDIF
  100.             IF (MOTa.EQ.'LOIEXT  ') THEN
  101.               IF (imodel.formod(1).EQ.'MECANIQUE       '.OR.
  102.      &            imodel.formod(1).EQ.'POREUX          '.OR.
  103.      &            imodel.FORMOD(1).EQ.'DIFFUSION       ') THEN
  104.                 CALL POSCHA(MOTa(1:6),iva)
  105.                 imodel.IVAMOD(io) = iva
  106.                 noblib = io+1
  107.                 imoLib = imodel.ivamod(io+2)
  108.                 imoFct = imodel.ivamod(io+3)
  109.                 GOTO 220
  110.               ENDIF
  111.             ENDIF
  112.           ENDIF
  113.         ENDDO
  114.  220    CONTINUE
  115.         IF (noblib.LE.0) GOTO 200
  116.  
  117.         CALL QUEVAL(imoLib,'MOT',ier,lli,r_z,m_libe,b_z,i_z)
  118.         IF (ier .NE. 0) CALL ERREUR(5)
  119.         CALL QUEVAL(imoFct,'MOT',ier,lmo,r_z,m_mode,b_z,i_z)
  120.         IF (ier .NE. 0) CALL ERREUR(5)
  121.         imodel.ivamod(noblib) = 0
  122.         i_z = -1
  123.         CALL LEXTOP(m_libe,m_mode,i_z,m_iloi,m_ptre)
  124.         if (m_iloi.gt.0) imodel.ivamod(noblib) = m_ptre
  125.         lli = LONG(m_libe)
  126.         CALL POSCHA(m_libe(1:lli),imoLib)
  127.         imodel.ivamod(noblib+1) = imoLib
  128.         lmo = LONG(m_mode)
  129.         CALL POSCHA(m_mode(1:lmo),imoFct)
  130.         imodel.ivamod(noblib+2) = imoFct
  131.  
  132.  200    continue
  133.       endif
  134.  
  135.       SEGDES,IMODEL
  136.  
  137.       RETURN
  138.       END
  139.  
  140.  
  141.  

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