Esope source files

   1 : C RESMMO    SOURCE    FANDEUR   14/01/22    21:15:17     7891           
   2 :       SUBROUTINE RESMMO (ICOLAC,ITLACC,IMAX1,IDEB)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : *--------------------------------------------------------------------*
   6 : *                                                                    *
   7 : *     Restauration des pointeurs issus de la pile des MODELEs.       *
   8 : *                                                                    *
   9 : *--------------------------------------------------------------------*
  10 : C***********************************************************************
  11 : C HISTORIQUE : 06/11/98 : rajout de la restitution de la table
  12 : C                         pour le modele 'NAVIER_STOKES'
  13 : C              On ne fait pas comme MILL car on ne comprend pas
  14 : C              sa modification (en fait, on ne comprend pas 
  15 : C              pourquoi elle n'est pas faite dans tous les
  16 : C              objets (cf. restch.eso pour les CHPOINTs))
  17 : C
  18 : C***********************************************************************
  19 : -INC CCOPTIO
  20 : -INC SMMODEL
  21 : -INC TMCOLAC
  22 :       character*8 cmate
  23 :       character*8 ityp1
  24 : *
  25 :       character*20 m_mode
  26 :       character*550 m_libe
  27 :       logical b_z
  28 : *     
  29 : *     Boucle sur les MODELEs contenus dans la pile:
  30 : *     
  31 :       ITLAC1 = KCOLA(1)
  32 : 
  33 :       ITLAC2 = KCOLA(10)
  34 :       ITLAC3 = KCOLA(40)
  35 :       DO 10 IEL=IDEB,IMAX1
  36 :          MMODEL = ITLAC(IEL)
  37 :          IF (MMODEL.EQ.0) GOTO 10
  38 :          SEGACT,MMODEL
  39 :          NSOUMO = KMODEL(/1)
  40 :          DO 20 ISOU=1,NSOUMO
  41 :             IMODEL=KMODEL(ISOU)
  42 :             IF (IMODEL.NE.0) THEN
  43 :                SEGACT,IMODEL*MOD
  44 :                IVA = ABS(IMAMOD)
  45 : *     
  46 : *  MILL  MODIF DU 11 / 6 / 92
  47 : *     
  48 : *              IF (IVA.NE.0) IMAMOD=ITLAC1.ITLAC(IVA)
  49 :                IF (IMAMOD.LT.0) IMAMOD=ITLAC1.ITLAC(IVA)
  50 : C    cas 'NAVIER_STOKES' : INFMOD(2) contient une table
  51 :                NFOR=FORMOD(/2)
  52 :                MN3=INFMOD(/1)
  53 :                do 715 iou=1,ivamod(/1)
  54 :                   ityp1=tymode(iou)
  54 :                   call typfil(ityp1,j)
  55 :                   iva=abs(ivamod(iou))  
  56 :                   if(j.le.0) go to 715
  57 :                   itlac4=KCOLA(J)
  58 :                   if( ivamod(iou).le.0) ivamod(iou)=itlac4.itlac(iva)
  59 :   715          continue           
  60 :                   
  61 :                IF (NFOR.GT.0) THEN
  62 :                   IF ((FORMOD(1).EQ.'NAVIER_STOKES') .OR.
  63 :      *                (FORMOD(1).EQ.'DARCY').OR.
  64 :      *                (FORMOD(1).EQ.'EULER')) THEN
  65 :                      IF (MN3.GT.1) THEN
  66 :                         IVA=ABS(INFMOD(2))
  67 :                         IF(IVA.NE.0) INFMOD(2)=ITLAC2.ITLAC(IVA)
  68 :                      ENDIF
  69 :                   ENDIF
  70 :                   do iou=3,mn3
  71 :                     if(infmod(iou).lt.0) then
  72 :                    iva=abs(infmod(iou))
  73 :                    infmod(iou)=itlac3.itlac(iva)
  74 :                    endif
  75 :                   enddo
  76 :                ENDIF
  77 :                if(mn3.lt.8.and.(formod(1).eq.'MECANIQUE'.or.
  78 :      *            formod(1).eq.'POREUX'))then
  79 :                    mn3=8
  80 :                    nfor=formod(/2)
  81 :                    nmat=matmod(/2)
  82 :                    nobmod=ivamod(/1)
  83 :                    segadj imodel
  83 :                    call prquoi(imodel)
  84 :                 
  84 :                  CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU)
  85 :                  IF (CMATE.EQ.' ') THEN
  86 :                     SEGSUP,IMODEL
  87 :                    SEGSUP,MMODEL
  87 :                    CALL ERREUR(251)
  88 :                    RETURN
  89 :                  ELSE
  90 :                    CMATEE=CMATE        
  91 :                    IMATEE=IMATE
  92 :                    INATUU=INATU
  93 :                  ENDIF
  94 : * initialisation des nomid
  95 :                IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER'
  96 :      &            .AND.formod(1).ne.'MELANGE') THEN
  97 :                  if(cmate.ne.'MODAL'.and.cmate.ne.'STATIQUE')  then
  98 :                   lucvar=0
  99 :                   lucmat=0
 100 :                   lucmaf=0
 101 :                   luparx=0
 101 :                   call inomid(imodel,'        ',iret,lucvar,lucmat,
 102 :      *             lucmaf,luparx) 
 103 :                  endif 
 104 :                ENDIF 
 105 :              endif         
 106 : 
 107 :              if (NFOR.eq.1) then
 108 :                if (nobmod.eq.0) goto 200
 109 :                noblib = 0
 110 :                if (formod(1).NE.'MECANIQUE' .AND.
 111 :      &             formod(1).NE.'POREUX') GOTO 210
 112 :                if (inatuu.ge.0) goto 200
 112 :                CALL PLACE(tymode,nobmod,noblib,'LMEEXT  ')
 113 :                if (noblib.eq.0) goto 200
 114 :                goto 220
 115 :  210           continue
 116 :                if (formod(1).NE.'DIFFUSION') goto 200
 116 :                CALL PLACE(tymode,nobmod,noblib,'LDIEXT  ')
 117 :                if (noblib.eq.0) goto 200
 118 : c*             goto 220
 119 :  220           continue 
 120 :                m_ptre = ivamod(noblib)
 121 :                if (m_ptre.le.0) then
 121 :                  call erreur(21)
 122 :                  return
 123 :                endif
 124 : C*TMP Option non disponible pour l'instant
 124 :                call erreur(251)
 125 :                return
 125 :                call queval(ivamod(noblib+1),'MOT',ier,lgmot,r_z,
 126 :      &                     m_libe,b_z,i_z)
 127 :                lglib = INDEX(m_libe,'=')-1
 128 :                lgmod = lgmot-liglib-1
 129 :                m_mode = m_libe(lglib+2:lgmot)//CHAR(0)
 130 :                m_libe = m_libe(1:lglib)//CHAR(0)
 130 : C**            CALL PTRLOI(m_libe,lglib,m_mode,lgmod,m_ptre)
 131 :                if (m_ptre.le.0) thEN
 131 :                  call erreur(21)
 132 :                  return
 133 :                endif
 134 :                ivamod(noblib) = m_ptre
 135 :  200           continue
 136 :              endif
 137 : 
 138 :                SEGDES,IMODEL
 139 :             ENDIF
 140 :  20      CONTINUE
 141 :          SEGDES,MMODEL
 142 :  10   CONTINUE
 143 :       RETURN
 144 :       END
 145 :  
 146 :