C SSTE1     SOURCE    PV090527  26/04/30    21:16:30     12529          

*************************************************************************
*************************************************************************
*************************************************************************
      SUBROUTINE SSTE1 (IPMODL,IPCHE1,IPCHE2,IPCHE4,IPCAR,
     .                    PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,
     .                    IPCHE7,IPCHE8,IPCHE9,IPRIGI)
*  entrees:
*  ipmodl = pointeur sur un objet mmodel
*  ipche1 = pointeur sur un mchaml de contraintes initiales
*  ipche2 = pointeur sur un mchaml de variables internes initiales
*  ipche4 = pointeur sur un mchaml d'increment elastique de deformations
*  ipcar  = pointeur sur un mchaml de caracteristiques
*  precis = precision des iterations internes
* sorties:
*  ipche7 = pointeur sur un mchaml de contraintes
*  ipche8 = pointeur sur un mchaml de variables internes
*  ipche9 = pointeur sur un mchaml de deformations
*  iprigi = pointeur sur l'objet de type rigidite
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME

-INC SMCOORD
-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMMODEL
-INC SMRIGID

-INC TMPTVAL

      SEGMENT NOTYPE
         CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT

      CHARACTER*8 CMATE
      CHARACTER*(NCONCH) CONM
      PARAMETER (NINF=3)
      INTEGER INFOS(NINF)

      CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
      IF (ISUP1.GT.1) RETURN
      CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
      IF (ISUP2.GT.1) RETURN
      CALL QUESUP(IPMODL,IPCHE4,5,0,ISUP4,IRET4)
      IF (ISUP4.GT.1) RETURN
      CALL QUESUP(IPMODL,IPCAR,3,0,ISUP5,IRET5)
      IF (ISUP5.GT.1) RETURN

      NBTYPE = 1
      SEGINI,notype
      notype.TYPE(1) = 'REAL*8  '
      MOTYR8 = notype
c
c Activar el modelo
c
      MMODEL=IPMODL
      NSOUS=MMODEL.KMODEL(/1)
c
c Creation de los 3 mchelms de salida
c
      N1=NSOUS
      L1=11
      N3=6
      SEGINI MCHELM
      MCHELM.TITCHE='CONTRAINTES'
      MCHELM.IFOCHE=IFOUR
      IPCHE7=MCHELM
      L1=18
      SEGINI MCHEL1
      MCHEL1.TITCHE='VARIABLES INTERNES'
      MCHEL1.IFOCHE=IFOUR
      IPCHE8=MCHEL1
      L1=12
      SEGINI MCHEL2
      MCHEL2.TITCHE='DEFORMATIONS'
      MCHEL2.IFOCHE=IFOUR
      IPCHE9=MCHEL2
c
c Creacion del objeto rigidite
c
      NRIGEL=NSOUS
      SEGINI MRIGID
      MRIGID.MTYMAT = 'RIGIDITE'
      MRIGID.ICHOLE=0
      MRIGID.IMGEO1=0
      MRIGID.IMGEO2=0
      MRIGID.IFORIG=IFOUR
      DO ISOUS=1,NSOUS
         MRIGID.COERIG(ISOUS)=1.D0
         MRIGID.IRIGEL(4,ISOUS)=0
      ENDDO
      IPRIGI=MRIGID
c
c     bucle sobre zonas
c
      DO 1000 ISOUS=1,NSOUS
         NSTR=0
         MOSTRS=0
         IVASTR=0
         MOVARI=0
         NVARI=0
         NVARF=0
         IVARI=0
         MOEPSI=0
         NDEF=0
         IVADEF=0
         IVADS=0
         NCARA=0
         NCARF=0
         MOCARA=0
         IVACAR=0
         NMATF=0
         NMATR=0
         MOMATR=0
         IVAMAT=0
         IVASTF=0
         IVARIF=0
         IVADEP=0
         KERRE=0
         KERR1=0
         MCHAML=0
         MCHAM1=0
         MCHAM2=0
c Recuperar la informacion general de la zona
c Activa el modelo de la zona
        IMODEL=KMODEL(ISOUS)
        MELE  =IMODEL.NEFMOD
        CONM  =IMODEL.CONMOD
c Activa la malla
        MELEME=IMODEL.IMAMOD
        NBNN  =MELEME.NUM(/1)
        NBELEM=MELEME.NUM(/2)
c Tipo de material
        CMATE  = imodel.CMATEE
        MATE   = imodel.IMATEE
        INPLAS = imodel.INATUU
c Controlar que sea uno de los materiales de trabajo
        IF ((INPLAS.lt.111).or.(INPLAS.gt.113)) then
          write(*,*) ' Material no disponible'
        ENDIF
ccc
*  informacion de elementos finitos
*  activa un segmento q se llama luego INFO, q tiene INFELE
      MELE =INFELE(1)
      NBGS =INFELE(4)
      NBG  =INFELE(6)
      IPORE=INFELE(8)
      LRE  =INFELE(9)
      LHOOK=INFELE(10)
      MINTE=INFMOD(7)
      MFR  =INFELE(13)
      NDDL =INFELE(15)
      NSTRS=INFELE(16)
        ippore=0
*  Controla que sean elementos masivos
      IF ((MFR.lt.1).or.(MFR.gt.1)) then
         write(*,*) ' Tipo de elemento no disponible'
      ENDIF
* Llena informacion en los 3 campos de salida
      MCHELM.IMACHE(ISOUS)=MELEME
      MCHELM.CONCHE(ISOUS)=CONM
      MCHEL1.IMACHE(ISOUS)=MELEME
      MCHEL1.CONCHE(ISOUS)=CONM
      MCHEL2.IMACHE(ISOUS)=MELEME
      MCHEL2.CONCHE(ISOUS)=CONM
      MCHELM.INFCHE(ISOUS,1)=0
      MCHELM.INFCHE(ISOUS,2)=0
      MCHELM.INFCHE(ISOUS,3)=NIFOUR
      MCHELM.INFCHE(ISOUS,4)=MINTE
      MCHELM.INFCHE(ISOUS,5)=0
      MCHELM.INFCHE(ISOUS,6)=5
      MCHEL1.INFCHE(ISOUS,1)=0
      MCHEL1.INFCHE(ISOUS,2)=0
      MCHEL1.INFCHE(ISOUS,3)=NIFOUR
      MCHEL1.INFCHE(ISOUS,4)=MINTE
      MCHEL1.INFCHE(ISOUS,5)=0
      MCHEL1.INFCHE(ISOUS,6)=5
      MCHEL2.INFCHE(ISOUS,1)=0
      MCHEL2.INFCHE(ISOUS,2)=0
      MCHEL2.INFCHE(ISOUS,3)=NIFOUR
      MCHEL2.INFCHE(ISOUS,4)=MINTE
      MCHEL2.INFCHE(ISOUS,5)=0
      MCHEL2.INFCHE(ISOUS,6)=5
* Llena informacion la rigidite
*  Activa segmento MINTE
      NBNO=NBNN
      NBPGAU=MINTE.POIGAU(/1)
      IPMINT=MINTE
*  Inicializa segmento descr, descripcion incognitas matriz rigidite
      NLIGRP=LRE
      NLIGRD=LRE
      SEGINI DESCR
      IPDESCR=DESCR

        nomid=lnomid(1)
        if (nomid.eq.0) then
          write(ioimp,*) 'LNOMID(1)=0'
          call erreur(5)
        endif
        modepl=nomid
        ndepl=lesobl(/2)
        ndum=lesfac(/2)

        nomid=lnomid(2)
        if (nomid.eq.0) then
          write(ioimp,*) 'LNOMID(2)=0'
          call erreur(5)
        endif
        moforc=nomid
        nforc=lesobl(/2)
        ndum=lesfac(/2)

*  Llena el segmento descr con los nombres de las incognitas
      IDDL=1
      NCOMP=NDEPL
      NBNNS=NBNN
      DO INOEUD=1,NBNNS
          DO ICOMP=1,NCOMP
               NOMID=MODEPL
               DESCR.LISINC(IDDL)=LESOBL(ICOMP)
               NOMID=MOFORC
               DESCR.LISDUA(IDDL)=LESOBL(ICOMP)
               NOELEP(IDDL)=INOEUD
               NOELED(IDDL)=INOEUD
               IDDL=IDDL+1
          ENDDO
      ENDDO
*  Inicializa segmento imatri, chapeau sur les segments
*      contenant les matrices de rigidite elementaires
      NELRIG =NBELEM
      rigrel=0
      SEGINI xMATRI
*  Trata la rigidite
      MRIGID.IRIGEL(1,ISOUS)=MELEME
      MRIGID.IRIGEL(2,ISOUS)=0
      MRIGID.IRIGEL(3,ISOUS)=IPDESCR
      MRIGID.IRIGEL(4,ISOUS)=xMATRI
      MRIGID.IRIGEL(5,ISOUS)=NIFOUR
      MRIGID.IRIGEL(6,ISOUS)=0
c     no simetricas = 2, simetricas = 0
      IRIGE7=2
      MRIGID.IRIGEL(7,ISOUS)=IRIGE7
      xmatri.symre=irige7
* tratamiento de los 4 campos dados
      NBNO=NBNNE(NUMGEO(MELE))
      CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
      IF (IRTD.EQ.0)THEN
         write(*,*)' no compatibles'
         RETURN
      ENDIF

*  contraintes: IVASTR
        nomid=lnomid(4)
        if (nomid.eq.0) then
          write(ioimp,*) 'LNOMID(4)=0'
          call erreur(5)
        endif
        mostrs=nomid
        nstr=lesobl(/2)
        nfac=lesfac(/2)
      CALL KOMCHA(IPCHE1,MELEME,CONM,MOSTRS,MOTYR8,1,INFOS,3,IVASTR)
      IF (ISUP1.EQ.1) THEN
       CALL VALCHE(IVASTR,NSTR,IPMINT,ippore,MOSTRS,MELE)
       goto 888
      ENDIF
*  variables internes: IVARI
        nomid=lnomid(10)
        if (nomid.eq.0) then
          write(ioimp,*) 'LNOMID(10)=0'
          call erreur(5)
        endif
        movari=nomid
        nvari=lesobl(/2)
        nvarf=lesfac(/2)
      NVART=NVARI+NVARF
      CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,MOTYR8,1,INFOS,3,IVARI)
      IF (ISUP2.EQ.1) THEN
       CALL VALCHE(IVARI,NVART,IPMINT,ippore,MOVARI,IELE)
       goto 888
      ENDIF
*  increments de deformations: IVADS
        nomid=lnomid(5)
        if (nomid.eq.0) then
          write(ioimp,*) 'LNOMID(5)=0'
          call erreur(5)
        endif
        moepsi=nomid
        ndef=lesobl(/2)
        nfac=lesfac(/2)

      CALL KOMCHA(IPCHE4,MELEME,CONM,MOEPSI,MOTYR8,1,INFOS,3,IVADS)
      IF (ISUP4.EQ.1) THEN
       CALL VALCHE(IVADS,NDEF,IPMINT,ippore,MOEPSI,MELE)
       goto 888
      ENDIF

*  caracteristiques materielles: IVAMAT
        nomid=lnomid(6)
        if (nomid.eq.0) then
          write(ioimp,*) 'LNOMID(6)=0'
          call erreur(5)
        endif
        momatr=nomid
        nmatr=lesobl(/2)
        nmatf=lesfac(/2)
      NMATT=NMATR+NMATF
      CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,MOTYR8,1,INFOS,3,IVAMAT)
      IF (ISUP5.EQ.1) THEN
       CALL VALCHE(IVAMAT,NMATT,IPMINT,ippore,MOMATR,MELE)
       goto 888
      ENDIF
* Creacion de los mchamls de las zonas
      NBPTEL=NBGS
      NEL   =NBELEM
      N1PTEL=NBPTEL
      N1EL  =NEL
*  contraintes
      N2    =NSTRS
      SEGINI MCHAML
      MCHELM.ICHAML(ISOUS)=MCHAML
      mchelm.conche(isous) = conmod
      NSR   =1
      NCOSOR=NSTRS
      SEGINI MPTVAL
      IVASTF=MPTVAL
      NOMID =MOSTRS
      DO ICOMP=1,NSTRS
         MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP)
         MCHAML.TYPCHE(ICOMP)='REAL*8'
         N2PTEL=0
         N2EL=0
         SEGINI MELVAL
         MCHAML.IELVAL(ICOMP)=MELVAL
         IVAL(ICOMP)=MELVAL
      enddo
*  variables internes
      N2    =NVART
      SEGINI MCHAM1
      MCHEL1.ICHAML(ISOUS)=MCHAM1
      mchel1.conche(isous) = conmod
      NSR   =1
      NCOSOR=NVART
      SEGINI MPTVAL
      IVARIF=MPTVAL
      NOMID=MOVARI
      DO ICOMP=1,NVARI
         MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
         MCHAM1.TYPCHE(ICOMP)='REAL*8'
         N2PTEL=0
         N2EL=0
         SEGINI MELVAL
         MCHAM1.IELVAL(ICOMP)=MELVAL
         IVAL(ICOMP)=MELVAL
      enddo
      DO ICOMP=NVARI+1,NVART
         MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP-NVARI)
         MCHAM1.TYPCHE(ICOMP)='REAL*8'
         N2PTEL=0
         N2EL=0
         SEGINI MELVAL
         MCHAM1.IELVAL(ICOMP)=MELVAL
         IVAL(ICOMP)=MELVAL
      enddo
      N1PTEL=NBPTEL
      N1EL=NEL
      N2=NDEF
      SEGINI MCHAM2
      MCHEL2.ICHAML(ISOUS)=MCHAM2
      mchel2.conche(isous) = conmod
      NSR=1
      NCOSOR=NDEF
      SEGINI MPTVAL
      IVADEP=MPTVAL
      NOMID=MOEPSI
      DO ICOMP=1,NDEF
         MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
         MCHAM2.TYPCHE(ICOMP)='REAL*8'
         N2PTEL=0
         N2EL=0
         SEGINI MELVAL
         MCHAM2.IELVAL(ICOMP)=MELVAL
         IVAL(ICOMP)=MELVAL
      enddo

      CALL SSTE2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
     .     NBELEM,NBPTEL,NBNN,LRE,MFR,
     .     IVASTR,IVARI,IVADS,IVAMAT,NSTRS,NVARI,NMATT,
     .     IVASTF,IVARIF,IVADEP,LHOOK,IRIGE7,
     .     PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,KERRE)

* Desactivar segmentos
         IF(ISUP1.EQ.1)THEN
            CALL DTMVAL (IVASTR,3)
         ELSE
            CALL DTMVAL (IVASTR,1)
         ENDIF
         IF(ISUP2.EQ.1)THEN
            CALL DTMVAL (IVARI,3)
         ELSE
            CALL DTMVAL (IVARI,1)
         ENDIF
         IF(ISUP4.EQ.1)THEN
            CALL DTMVAL (IVADS,3)
         ELSE
            CALL DTMVAL (IVADS,1)
         ENDIF
         IF(ISUP5.EQ.1)THEN
            CALL DTMVAL (IVAMAT,3)
         ELSE
            CALL DTMVAL (IVAMAT,1)
         ENDIF
         IF (KERRE.EQ.0) THEN
            CALL DTMVAL (IVASTF,1)
            CALL DTMVAL (IVARIF,1)
            CALL DTMVAL (IVADEP,1)
         ELSE
            CALL DTMVAL (IVASTF,3)
            CALL DTMVAL (IVARIF,3)
            CALL DTMVAL (IVADEP,3)
            SEGSUP MCHAML,MCHAM1,MCHAM2
            GO TO 888
         END IF
1000  continue

 888  CONTINUE
      IF(KERRE.NE.0)THEN
         SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID,xMATRI,DESCR
      ENDIF

      notype = MOTYR8
      SEGSUP,notype

      RETURN
      END