C VMISPO    SOURCE    AM        13/12/16    21:16:12     7825           
      SUBROUTINE VMISPO(IPMODL,IPCHE1,IPCHE2,ICONV,IPCHE3,IRET)
C_______________________________________________________________________
C
C  Entrées:
C  ________
C
C     IPMODL  Pointeur sur un MMODEL
C     IPCHE1  Pointeur sur un MCHAML de contraintes
C     IPCHE2  Pointeur sur un MCHAML de caractéristiques
C     ICONV   Flag précisant s'il y a eu conversion
C
C  SORTIES:
C  ________
C
C     IPCHE3  Pointeur sur un MCHAML de VONMISES
C     IRET =1  OU  0   suivant succes ou pas (Message d'erreur
C                                         imprimé dans ce cas)
C
C    Passage aux nouveaux CHAMELEMs par I.Monnier le 13.06.90
C
*_______________________________________________________________________
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
-INC CCOPTIO
-INC CCHAMP
-INC CCGEOME
-INC SMCHAML
-INC SMMODEL
-INC SMCOORD
-INC SMINTE
*
      SEGMENT NOTYPE
        CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT
*
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
*
      CHARACTER*(NCONCH) CONM
      PARAMETER ( NINF=3 )
      DIMENSION SIG(9)
      DIMENSION CARAC(25),DIV(7)
      INTEGER INFOS(NINF)
      LOGICAL lsupco
      DATA ALPH1/.4444444444444444D0/
      DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/

*      WRITE(*,*) 'Entrée dans VMISPO.'
      IRET = 0
      IPCHE3 = 0
*
*     Verification du lieu support du MCHAML de CONTRAINTES
*
      ISUP1 = 0
      IRET1 = 0
      CALL QUESUP (IPMODL,IPCHE1,0,0,ISUP1,IRET1)
*     IF (ISUP1.GT.0) RETURN
*
*     Verification du lieu support du MCHAML de CARACTERISTIQUES
*
      IF (IPCHE2.NE.0) THEN
         ISUP2 = 0
         IRET2 = 0
         CALL QUESUP (IPMODL,IPCHE2,IRET1,1,ISUP2,IRET2)
         IF (ISUP2.GT.0) RETURN
      ENDIF
*
*_______________________________________________________________________
*
*                   ACTIVATION DU MODELE
*_______________________________________________________________________
*
      MMODEL=IPMODL
      SEGACT,MMODEL
      NSOUS=KMODEL(/1)
      KEL22 = 0
      DO ISOUS = 1, NSOUS
        IMODEL=KMODEL(ISOUS)
        SEGACT,IMODEL
        IF (NEFMOD.EQ.22.or.formod.ne.'MECANIQUE') KEL22 = KEL22 + 1
      ENDDO
*
*     ACTIVATION DES CONTRAINTES
*
      IRET=1
      MCHEL1=IPCHE1
      SEGACT MCHEL1
*
*     INITIALISATION DU MCHELM DE VON MISES
*
      L1=9
      N1=NSOUS - KEL22
      N3=6
      SEGINI MCHELM
      IFOCHE=IFOUR
      TITCHE='VON MISES'
*_______________________________________________________________________
*
*               BOUCLE SUR LES SOUS ZONES
*_______________________________________________________________________
*
      isouss=0
      DO 200 ISOUS=1,NSOUS
C
C    QUELQUES INITIALISATIONS
C
      MOSTRS = 0
      MOCARA = 0
      IVASTR = 0
      IVACAR = 0
      IVAMIS = 0
C
C     TRAITEMENT DU MODELE
C
      IMODEL=KMODEL(ISOUS)
C*    SEGACT IMODEL
      MELE=NEFMOD
        IF (NEFMOD.EQ.22.or.formod.ne.'MECANIQUE') goto 200 
      ISOUSS=ISOUSS+1
*
      IPMAIL=IMAMOD
      CONM  =CONMOD
C
C     CREATION DU TABLEAU INFOS
C
      CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
      IF (IRTD.EQ.0) GOTO 9990
C
C   COQUE INTEGREE OU PAS ?
C
         IF(INFMOD(/1).NE.0)THEN
           NPINT=INFMOD(1)
         ELSE
           NPINT=0
         ENDIF
C_______________________________________________________________________
C
C     INFORMATIONS SUR L'ELEMENT FINI
C_______________________________________________________________________
C
*      CALL ELQUOI(MELE,0,IRET1,IPINF,IMODEL)
*      IF (IERR.NE.0) THEN
*        SEGDES IMODEL,MMODEL
*        SEGSUP MCHELM
*        SEGDES MCHEL1
*        RETURN
*      ENDIF
*      INFO=IPINF
      MFR   =INFELE(13)
      NSTRS =INFELE(16)
      NBPGAU=INFELE( 4)
*      MINTE =INFELE(11)
      MINTE=INFMOD(iret1+2)
      IPPORE=0
      IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE))
      IPMINT=MINTE
      SEGACT,MINTE
*      SEGSUP INFO
C
C     RECOPIE DU MCHELM
C
      IMACHE(ISOUSS)=IPMAIL
      CONCHE(ISOUSS)=CONMOD
C
      INFCHE(ISOUSS,1)=0
      INFCHE(ISOUSS,2)=0
      INFCHE(ISOUSS,3)=NIFOUR
      INFCHE(ISOUSS,4)=MINTE
      INFCHE(ISOUSS,5)=0
      INFCHE(ISOUSS,6)=IRET1
C
C     CREATION DU MCHAML
C
      N2=1
      SEGINI MCHAML
      ICHAML(ISOUSS)=MCHAML
      NOMCHE(1)='SCAL'
      TYPCHE(1)='REAL*8'
C_______________________________________________________________________
C
C     NOMS DE COMPOSANTES NECESSAIRES
C_______________________________________________________________________
C
      if(lnomid(4).ne.0) then
         nomid=lnomid(4)
         segact nomid
         mostrs=nomid
         nstr=lesobl(/2)
         nfac=lesfac(/2)
         lsupco=.false.
      else 
         lsupco=.true.
        CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
      endif
C
C     VERIFICATION DE LEUR PRESENCE
C
      NBTYPE=1
      SEGINI NOTYPE
      MOTYPE=NOTYPE
      TYPE(1)='REAL*8'
C
      CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
      SEGSUP NOTYPE
      IF (IERR.NE.0) GOTO 9990
*
      IF (ISUP1.EQ.1) CALL VALCHE (IVASTR,NSTR,IPMINT,IPPORE)
C
C     RECHERCHE DES TAILLES DE MELVAL
C
      N1EL=0
      N1PTEL=0
      MPTVAL=IVASTR
      DO 20 IO=1,NSTRS
        MELVAL=IVAL(IO)
        N1PTEL=MAX(N1PTEL,VELCHE(/1))
        N1EL  =MAX(N1EL  ,VELCHE(/2))
 20   CONTINUE
      IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
        N1PTEL=1
      ELSE
*PVPVPV N1PTEL=NBPGAU
      ENDIF
      NBPTEL=N1PTEL
      NEL   =N1EL
C
C     CREATION DU MELVAL VMISES
C
      N2PTEL=0
      N2EL=0
      SEGINI MELVAL
      IELVAL(1)=MELVAL
      IVAMIS   =MELVAL
*
*     ON TRAITE LES COQUES INTEGREES COMME LES MASSIFS
*
      IF(NPINT.NE.0)THEN
            MFR1=1
      ELSE
           MFR1=MFR
      ENDIF
C_______________________________________________________________________
*
* TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
C_______________________________________________________________________
*
           NBROBL=0
           NBRFAC=0
           MOCARA=0
           IVECT=0
*
* EPAISSEUR ET ALFA DANS LE CAS DES COQUES
*
         IF (MFR1.EQ.3.OR.MFR1.EQ.5.OR.MFR1.EQ.9) THEN
           NBROBL=1
           NBRFAC=1
           SEGINI NOMID
           MOCARA=NOMID
           LESOBL(1)='EPAI'
           LESFAC(1)='CALF'
*
           NBTYPE=1
           SEGINI NOTYPE
           TYPE(1)='REAL*8'
*
* CARACTERISTIQUES POUR LES POUTRES
*
         ELSE IF (MFR1.EQ.7 ) THEN
           NBROBL=4
           NBRFAC=3
           SEGINI NOMID
           MOCARA=NOMID
           LESOBL(1)='TORS'
           LESOBL(2)='INRY'
           LESOBL(3)='INRZ'
           LESOBL(4)='SECT'
           LESFAC(1)='DX  '
           LESFAC(2)='DY  '
           LESFAC(3)='DZ  '
*
           NBTYPE=1
           SEGINI NOTYPE
           TYPE(1)='REAL*8'
*
* CARACTERISTIQUES POUR LES TUYAUX
*
         ELSE IF (MFR1.EQ.13) THEN
           NBROBL=2
           NBRFAC=9
           SEGINI NOMID
           MOCARA=NOMID
           LESOBL(1)='EPAI'
           LESOBL(2)='RAYO'
           LESFAC(1)='RACO'
           LESFAC(2)='PRES'
           LESFAC(3)='CISA'
           LESFAC(4)='CFFX'
           LESFAC(5)='CFMX'
           LESFAC(6)='CFMY'
           LESFAC(7)='CFMZ'
           LESFAC(8)='CFPR'
           LESFAC(9)='VECT'
           IVECT=1
*
           NBTYPE=11
           SEGINI NOTYPE
           TYPE(1)='REAL*8'
           TYPE(2)='REAL*8'
           TYPE(3)='REAL*8'
           TYPE(4)='REAL*8'
           TYPE(5)='REAL*8'
           TYPE(6)='REAL*8'
           TYPE(7)='REAL*8'
           TYPE(8)='REAL*8'
           TYPE(9)='REAL*8'
           TYPE(10)='REAL*8'
           TYPE(11)='POINTEURPOINT   '
         ENDIF
*
         NCARA=NBROBL
         NCARF=NBRFAC
         NCARR=NCARA+NCARF
         IF (MOCARA.NE.0)  THEN
           MOTYPE=NOTYPE
             IF (IPCHE2.NE.0)  THEN
               CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,
     1                                        1,INFOS,3,IVACAR)
               SEGSUP NOTYPE
               IF (IERR.NE.0) GOTO 9990
             ELSE
               SEGSUP NOTYPE
               MOTERR(1:8)='CARACTER'
               MOTERR(9:12)=NOMTP(MELE)
               MOTERR(13:20)='VMIS'
               CALL ERREUR(145)
               GOTO 9990
             ENDIF
*
             IF (ISUP2.EQ.1) THEN
                 CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE)
                 IF(IERR.NE.0)THEN
                   ISUP2=0
                   GOTO 9990
                ENDIF
             ENDIF
           ENDIF
*
C_______________________________________________________________________
C
C     BRANCHEMENT SUIVANT LA FORMULATION
C
C_______________________________________________________________________
C          MASSI COQUE COQEP POUT  CIST  THER  TUYA  LISP
      GOTO (30,22,60,22,80,22,120,22,70,22,22,22,120,22,90,22,22,
C                                                  INCO  PORE
     .      22,22,22,22,22,22,22,22,22,22,22,22,22,30,22,30),MFR1
c     cas Xfem: identique au cas massif
      IF(MFR.EQ.63) goto 30
C
  22  CONTINUE
      MOTERR(1:8)=NOMFR(MFR1/2+1)
      CALL ERREUR(193)
      GOTO 9990
C_______________________________________________________________________
C
C    FORMULATION MASSIVE
C_______________________________________________________________________
C
   30 CONTINUE
      DO 31 IB=1,NEL
      DO 31 IGAU=1,NBPTEL
        MPTVAL=IVASTR
        DO 35 ICOMP=1,NSTRS
          MELVAL=IVAL(ICOMP)
          IGMN=MIN(IGAU,VELCHE(/1))
          IBMN=MIN(IB  ,VELCHE(/2))
          SIG(ICOMP)=VELCHE(IGMN,IBMN)
   35   CONTINUE
      VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)-SIG(1)*SIG(2)
     +       -SIG(1)*SIG(3)-SIG(2)*SIG(3)
C
        IF (IDIM.NE.1) THEN
        DO 33 IE=4,NSTRS
          VONMIS=VONMIS+3.D0*(SIG(IE)*SIG(IE))
  33    CONTINUE
        ENDIF
C
        XXXX=SQRT(ABS(VONMIS))
        MELVAL=IVAMIS
        VELCHE(IGAU,IB)=XXXX
   31 CONTINUE
      GOTO 150
C_______________________________________________________________________
C
C    FORMULATION COQUE
C_______________________________________________________________________
C
   60 CONTINUE
C
      DO 61 IB=1,NEL
      DO 61 IGAU=1,NBPTEL
        MPTVAL=IVASTR
        DO 62 ICOMP=1,NSTRS
          MELVAL=IVAL(ICOMP)
          IGMN=MIN(IGAU,VELCHE(/1))
          IBMN=MIN(IB  ,VELCHE(/2))
          SIG(ICOMP)=VELCHE(IGMN,IBMN)
   62   CONTINUE
C
      MPTVAL=IVACAR
      MELVAL=IVAL(1)
        IGMN=MIN(IGAU,VELCHE(/1))
        IBMN=MIN(IB  ,VELCHE(/2))
        EPAIST=VELCHE(IGMN,IBMN)
*
      CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
      MPTVAL=IVACAR
      MELVAL=IVAL(2)
      IF (MELVAL.NE.0) THEN
        IGMN=MIN(IGAU,VELCHE(/1))
        IBMN=MIN(IB  ,VELCHE(/2))
        ALPHA=VELCHE(IGMN,IBMN)
      ELSE
        ALPHA=0.666666666666666666D0
      ENDIF
      ALPHA=ALPHA*ALPHA
C
      IF(IFOUR.GT.0) THEN
      VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
     +       3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)-
     +       SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6))))
      ELSE IF(IFOUR.LE.0) THEN
      VONMIS= SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
     +     ALPHA*(SIG(3)*SIG(3)+SIG(4)*SIG(4)-SIG(3)*SIG(4))
      VONMIS=SQRT(VONMIS)
      ENDIF
C
      MELVAL=IVAMIS
      VELCHE(IGAU,IB)=VONMIS
   61 CONTINUE
      GOTO 150
C_______________________________________________________________________
C
C    FORMULATION COQUE AVEC CISAILLEMENT TRANSVERSE (COQ4)
C_______________________________________________________________________
C
   70 CONTINUE
C
      DO 71 IB=1,NEL
      DO 71 IGAU=1,NBPTEL
        MPTVAL=IVASTR
        DO 72 ICOMP=1,NSTRS
          MELVAL=IVAL(ICOMP)
          IGMN=MIN(IGAU,VELCHE(/1))
          IBMN=MIN(IB  ,VELCHE(/2))
          SIG(ICOMP)=VELCHE(IGMN,IBMN)
   72   CONTINUE
C
      MPTVAL=IVACAR
      MELVAL=IVAL(1)
        IGMN=MIN(IGAU,VELCHE(/1))
        IBMN=MIN(IB  ,VELCHE(/2))
        EPAIST=VELCHE(IGMN,IBMN)
*
      CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
      MPTVAL=IVACAR
      MELVAL=IVAL(2)
      IF (MELVAL.NE.0) THEN
        IGMN=MIN(IGAU,VELCHE(/1))
        IBMN=MIN(IB  ,VELCHE(/2))
        ALPHA=VELCHE(IGMN,IBMN)
      ELSE
        ALPHA=0.666666666666666666D0
      ENDIF
      ALPHA=ALPHA*ALPHA
C
      VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
     +       3.D0*SIG(7)*SIG(7)+3.D0*SIG(8)*SIG(8)+
     +       3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)-
     +       SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6))))
C
      MELVAL=IVAMIS
      VELCHE(IGAU,IB)=VONMIS
   71 CONTINUE
      GOTO 150
C_______________________________________________________________________
C
C    FORMULATION COQUE EPAISSE
C_______________________________________________________________________
C
   80 CONTINUE
      DO 81 IB=1,NEL
      DO 81 IGAU=1,NBPTEL
        MPTVAL=IVASTR
        DO 85 ICOMP=1,NSTRS
          MELVAL=IVAL(ICOMP)
          IGMN=MIN(IGAU,VELCHE(/1))
          IBMN=MIN(IB  ,VELCHE(/2))
          SIG(ICOMP)=VELCHE(IGMN,IBMN)
   85   CONTINUE
        VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)
     1   + 3.D0*(SIG(3)*SIG(3)+SIG(4)*SIG(4)+SIG(5)*SIG(5))
C
        XXXX=SQRT(ABS(VONMIS))
        MELVAL=IVAMIS
        VELCHE(IGAU,IB)=XXXX
   81 CONTINUE
      GOTO 150
C_______________________________________________________________________
C
C    FORMULATION LINESPRING
C_______________________________________________________________________
C
   90 CONTINUE
      DO 110 IB=1,NEL
      DO 110 IGAU=1,NBPTEL
        MPTVAL=IVASTR
        DO 100 ICOMP=1,NSTRS
          MELVAL=IVAL(ICOMP)
          IGMN=MIN(IGAU,VELCHE(/1))
          IBMN=MIN(IB  ,VELCHE(/2))
          SIG(ICOMP)=VELCHE(IGMN,IBMN)
  100   CONTINUE
        VONMIS=SQRT(ABS(SIG(1)*SIG(1)+ALPH1*SIG(4)*SIG(4)))
C
        MELVAL=IVAMIS
        VELCHE(IGAU,IB)=VONMIS
  110 CONTINUE
      GOTO 150
C_______________________________________________________________________
C
C    FORMULATION POUTRE ET TUYAU
C_______________________________________________________________________
C
  120 CONTINUE
      DO 121 IB=1,NEL
      DO 121 IGAU=1,NBPTEL
        MPTVAL=IVASTR
        DO 122 ICOMP=1,NSTRS
          MELVAL=IVAL(ICOMP)
          IGMN=MIN(IGAU,VELCHE(/1))
          IBMN=MIN(IB  ,VELCHE(/2))
          SIG(ICOMP)=VELCHE(IGMN,IBMN)
 122    CONTINUE
C
        MPTVAL=IVACAR
        NCARR1=NCARR
        IF(IVECT.EQ.1) NCARR1=NCARR-1
        DO 123 ICOMP=1,NCARR1
          MELVAL=IVAL(ICOMP)
          IF (MELVAL.NE.0) THEN
            IGMN=MIN(IGAU,VELCHE(/1))
            IBMN=MIN(IB  ,VELCHE(/2))
            CARAC(ICOMP)=VELCHE(IGMN,IBMN)
          ELSE
            CARAC(ICOMP)=0.D0
          ENDIF
 123    CONTINUE
C
C       CAS OU ON A LU LE MOT VECTEUR
C
        IF (IVECT.EQ.1) THEN
          IF (IVAL(NCARR).NE.0) THEN
            MELVAL=IVAL(NCARR)
            IBMN=MIN(IB,IELCHE(/2))
            IP=IELCHE(1,IBMN)
            IREF=(IP-1)*(IDIM+1)
            DO 6129 IC=1,IDIM
              CARAC(NCARR+IC-1)=XCOOR(IREF+IC)
 6129       CONTINUE
          ELSE
            DO 6229 IC=1,IDIM
              CARAC(NCARR+IC-1)=0.D0
 6229       CONTINUE
          ENDIF
        ENDIF
C
        SIGPRE=0.D0
        IF(MFR1.EQ.7) THEN
          DIV(1)=1.D0/CARAC(4)
          DIV(2)=1.D0
          DIV(3)=1.D0
          DIV(4)=CARAC(5)/CARAC(1)
          DIV(5)=CARAC(6)/CARAC(2)
          DIV(6)=CARAC(7)/CARAC(3)
        ELSE IF(MFR1.EQ.13) THEN
          EPAIS=CARAC(1)
          REXT =CARAC(2)
          RMOY =REXT-EPAIS*0.5D0
          RACO =CARAC(3)
          PRES =CARAC(4)
          CISA =CARAC(5)
C
          GAM=1.D0
          IF(RACO.EQ.0.D0) GO TO 125
          XLAM=RMOY*RMOY/EPAIS/RACO
          GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
          IF(GAM.LT.1.D0) GAM=1.D0
 125      CONTINUE
C
C         NB 23/09/98
C         VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
C         CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
C         CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
C         DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
C         DUE A LA PRESSION )
C
          DIV(1)=1.D0
          DIV(2)=1.D0
          DIV(3)=1.D0
          DIV(4)=R33
          DIV(5)=PI4*GAM
          DIV(6)=DIV(5)
          DIV(7)=0.D0
C
          DO 1255 ICOMP=6,10
            MELVAL=IVAL(ICOMP)
            IF (MELVAL.NE.0) DIV(ICOMP-3)=CARAC(ICOMP)
 1255     CONTINUE
C
C         NB 23/09/98
C         TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
C         1.D0 DE DIV(3)
C
          DIV(1) = DIV(3)
          DIV(3)=1.D0
C
C   RE-ARRANGEMENT DE CARAC POUR TUYCAR
C
          CISA=CARAC(5)
          CARAC(4)=CARAC(11)
          CARAC(5)=CARAC(12)
          CARAC(6)=CARAC(13)
C
          VX=CARAC(4)
          VY=CARAC(5)
          VZ=CARAC(6)
          CALL TUYCAR(CARAC,CISA,VX,VY,VZ,KERRE,1)
          DIV(1)=DIV(1)/CARAC(4)
          DIV(4)=DIV(4)*RMOY/CARAC(1)
          DIV(5)=DIV(5)*RMOY/CARAC(2)
          DIV(6)=DIV(6)*RMOY/CARAC(3)
          SIGPRE=DIV(7)*RMOY*PRES/EPAIS
        ENDIF
C
        VONMIS=SQRT(ABS((SIG(1)*DIV(1))**2+(SIG(4)*DIV(4))**2+
     .                  (SIG(5)*DIV(5))**2+(SIG(6)*DIV(6))**2+
     .                   SIGPRE**2 ))
C
        MELVAL=IVAMIS
        VELCHE(IGAU,IB)=VONMIS
C
  121 CONTINUE
      GOTO 150
C
C_______________________________________________________________________
C
C     AUTRE FORMULATION
C_______________________________________________________________________
C
  150 CONTINUE
C
C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
C
      IF(ISUP1.EQ.1)THEN
           CALL DTMVAL(IVASTR,3)
      ELSE
          CALL DTMVAL(IVASTR,1)
      ENDIF
*
      MELVAL=IVAMIS
      SEGDES MELVAL
*
      IF(ISUP2.EQ.1)THEN
           CALL DTMVAL(IVACAR,3)
      ELSE
          CALL DTMVAL(IVACAR,1)
      ENDIF
*
      NOMID =MOSTRS
      if(lsupco)SEGSUP NOMID
      NOMID =MOCARA
      IF (MOCARA.NE.0) SEGSUP NOMID
*
      SEGDES MCHAML
  201 CONTINUE
      SEGDES,MINTE
C
  200 CONTINUE

      SEGDES MCHELM
      SEGDES MCHEL1
      IRET = 1
      IPCHE3 = MCHELM
      GOTO 888
*
*     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
*
 9990 CONTINUE
*
      IF(ISUP1.EQ.1)THEN
           CALL DTMVAL(IVASTR,3)
      ELSE
          CALL DTMVAL(IVASTR,1)
      ENDIF
*
      IF(ISUP2.EQ.1)THEN
           CALL DTMVAL(IVACAR,3)
      ELSE
          CALL DTMVAL(IVACAR,1)
      ENDIF
*
      NOMID =MOSTRS
      if(lsupco)SEGSUP NOMID
      NOMID =MOCARA
      IF (MOCARA.NE.0) SEGSUP NOMID
*
      IF (IVAMIS.NE.0) THEN
         MELVAL=IVAMIS
         SEGSUP MELVAL
      ENDIF
*
      SEGDES,MINTE
      SEGSUP MCHAML
*
      SEGDES MCHEL1
      SEGSUP MCHELM

      IRET = 0
      IPCHE3 = 0
*
 888  CONTINUE
      DO ISOUS = 1, NSOUS
        IMODEL=KMODEL(ISOUS)
        SEGDES,IMODEL
      ENDDO
      SEGDES MMODEL

      RETURN
      END