C PIMODL    SOURCE    JK148537  26/10/19    21:15:13     12674          

*=======================================================================
*= SOUS-PROGRAMME PERMETTANT DE DEROULER UN MMODEL                     =
*= (UTILE SURTOUT EN CAS DE MODELE MELANGE)                            =
*=                                                                     =
*= IPMOD0  MMODEL initial complet                                      =
*= IPMOD1  MMODEL "deroule" contenant, de maniere unitaire, les sous-  =
*=         modeles de formulation 'MECANIQUE', 'LIQUIDE' et 'POREUX'   =
*=         vaut 0 en cas d'ERREUR (MMODEL "deroule" vide)              =
*= IPMAI1  MAILLAGE "deroule" contenant, pour chaque sous-modele de    =
*=         IPMOD1, le maillage support (type 28) si le mode de calcul  =
*=         est de type DPGE (2D/1D)                                    =
*=         vaut 0 si non utile/defini                                  =
*= INIVE = 0 sans 'MELANGE'  avec sous-modeles encapsules              =
*=       = 1 avec 'MELANGE' et sous-modeles encapsules sauf 'PARALLELE'=
*=       = 2 avec 'MELANGE' et sous-modeles encapsules si 'PARALLELE'  =
*= Nota : - IPMOD0 / IPMOD1 est ACTIF en entree / sortie.              =
*=        - Tous les sous-modeles de IPMOD1 sont ACTIFs en sortie !    =
*=======================================================================

      SUBROUTINE PIMODL (IPMOD0,IPMOD1,IPMAI1,INIVE)

      IMPLICIT INTEGER (I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCPRECO

-INC SMMODEL
-INC SMELEME
      POINTEUR ipt0.meleme

      CHARACTER*(16) moforg
      LOGICAL lDPGE

      IPMOD1 = 0
      IPMAI1 = 0

      iimpi0 = IIMPI
c*dbg      iimpi0 = 1972

      mmodel = IPMOD0
c*      segact,mmodel*nomod   <- Actif en E/S

C PRECOnditionnment "CMODPG" des MODELES mecaniques en mode DPGE (2D/1D)
C ======================================================================
C Recherche si le modele IPMOD0 n'a pas deja ete traite :
C Verification si presence dans le preconditionnement CCPRECO / "CMODPG"
      ith   = oothrd
      ith1  = ith + 1

      CALL OOOHO1(mmodel,ihorot)
      ITAILL = NBMODP(ith1)
      DO is = 1, ITAILL
        IF ( PMODPE(is,ith1) .EQ. mmodel .AND.
     &       PMODPH(is,ith1) .EQ. ihorot ) THEN
          mmode1 = PMODPS(is,ith1)
          meleme = PMADPS(is,ith1)
          if (iimpi0.eq.1972) then
            write(ioimp,*) 'Preconditionnement PIMODL trouve',
     &                     mmodel,mmode1,meleme,is
          endif
C       Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1
          IF (is .GT. 1) THEN
            DO js = is, 2, -1
              PMODPE(js,ith1) = PMODPE(js - 1,ith1)
              PMODPH(js,ith1) = PMODPH(js - 1,ith1)
              PMODPS(js,ith1) = PMODPS(js - 1,ith1)
              PMADPS(js,ith1) = PMADPS(js - 1,ith1)
            ENDDO
            PMODPE(1,ith1) = mmodel
            PMODPH(1,ith1) = ihorot
            PMODPS(1,ith1) = mmode1
            PMADPS(1,ith1) = meleme
          ENDIF
          IF (mmode1.NE.0 .AND. mmode1.NE.mmodel)
     &      CALL ACTOBJ('MMODEL  ',mmode1,1)
          IF (meleme.NE.0) CALL ACTOBJ('MAILLAGE',meleme,1)
          IPMOD1 = mmode1
          IPMAI1 = meleme
          if (iimpi0.eq.1972)
     &      write(ioimp,*) 'PIMODL : IPMOD1 avec NSOU1 =',
     &                     mmode1.kmodel(/1)
          GOTO 100
        ENDIF
      ENDDO

C On deroule le MODELE des MODELES mecaniques en mode DPGE (2D/1D)
C ======================================================================
cjk148537
      if (mmode1.le.0) mmode1 = ipmod0
      NSOU1 = mmode1.kmodel(/1)
      if (iimpi0.eq.1972)
     &   write(ioimp,*) 'PIMODL : IPMOD1 avec NSOU1 =',NSOU1
      IF (NSOU1.LE.0) THEN
        write(ioimp,*) 'PIMODL : IPMOD1 vide - NSOU1 = 0'
        CALL ERREUR(-182)
        GOTO 99
      ENDIF
      ipt1 = 0

C- Test si le mode de calcul courant est "DPGE"
      mfr = 1
      CALL INFDPG(mfr,IFOUR,lDPGE,ndpge)
      IF (lDPGE) THEN
        NBNN   = 0
        NBELEM = 0
        NBREF  = 0
        NBSOUS = 0
        SEGINI,ipt0
        SEGACT,ipt0*NOMOD

        NBSOUS = NSOU1
        SEGINI,ipt1

        N1 = 0
        DO is = 1, NSOU1
          imodel = mmode1.kmodel(is)
          mfr  = imodel.INFELE(13)
          CALL INFDPG(mfr,IFOUR,lDPGE,ndpge)
          IF (lDPGE) THEN
            IIPDPG = imodel.IPDPGE
            IIPDPG = IPTPOI(IIPDPG)
            IF (IIPDPG.LE.0) THEN
              CALL ERREUR(925)
              CALL ERREUR(5)
              GOTO 99
            ENDIF
            ipt3 = imodel.imamod
            NBNN3  = ipt3.NUM(/1)
            NBNN   = NBNN3+1
            NBELEM = ipt3.NUM(/2)
            NBREF  = 0
            NBSOUS = 0
            SEGINI,meleme
            meleme.ITYPEL=28
            DO i = 1, NBELEM
              DO j = 1, NBNN3
                meleme.NUM(j,i) = ipt3.NUM(j,i)
              ENDDO
              meleme.NUM(NBNN,i) = IIPDPG
              meleme.ICOLOR(i) = ipt3.ICOLOR(i)
            ENDDO
            SEGACT,meleme*NOMOD
            N1 = N1 + 1
          ELSE
            meleme = ipt0
          ENDIF
          ipt1.lisous(is) = meleme
        ENDDO
        SEGACT,ipt1*NOMOD
        IF (N1.EQ.0) THEN
          segsup,ipt1,ipt0
          ipt1 = 0
        ENDIF

      ENDIF

      IPMOD1 = mmode1
      IPMAI1 = ipt1

C  Mise a jour du preconditionnement CCPRECO / "CMODPG"
C  Si N1SM non nul et INIVE different de 1, pas de preco ... En attendant mieux !
      if (N1SM.NE.0 .AND. INIVE.NE.1) then
        if (iimpi0.eq.1972)
     &    write(ioimp,*) 'PIMODL : Preconditionnement non retenu ',
     &                   NSOU1,N1SM,INIVE
        goto 99
      endif

      ITAILL       = MIN(ITAILL + 1, NPMDPG)
      NBMODP(ith1) = ITAILL
      DO is = ITAILL, 2, -1
        PMODPE(is,ith1) = PMODPE(is - 1,ith1)
        PMODPH(is,ith1) = PMODPH(is - 1,ith1)
        PMODPS(is,ith1) = PMODPS(is - 1,ith1)
        PMADPS(is,ith1) = PMADPS(is - 1,ith1)
      ENDDO
      PMODPE(1,ith1) = mmodel
      PMODPH(1,ith1) = ihorot
      PMODPS(1,ith1) = mmode1
      PMADPS(1,ith1) = ipt1
      if (iimpi0.eq.1973) then
        write(ioimp,*) 'PIMODL : Preconditionnement realise',
     &                 mmodel,mmode1,ipt1,itaill
      endif

C Sortie du sous-programme (menage...)
 99   CONTINUE
 100  CONTINUE

      RETURN
      END