C HHOPIL    SOURCE    OF166741  24/12/18    21:15:15     12092          

C====== FORMULATION HHO ================================================
C= 
C= (1) Initialisations/Verifications - SAUVER
C=
C=======================================================================

      SUBROUTINE HHOPIL(iopt,ient1,ient2)

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

-INC PPARAM
-INC CCOPTIO

-INC CCHHOPA
-INC CCHHOPR
-INC CCHHORS

-INC SMLENTI
-INC TMCOLAC

      DIMENSION ILENA(5)

c-dbg      write(ioimp,*) 'HHOPIL E(',iopt,') :',ient1,ient2

C= 1 = INITIALISATIONS/VERIFICATIONS = SAUVER ==========================
      IF (iopt .EQ. 1) THEN
        ISAUHO = -99
        IRESHO = -99
        ISSQHO = 0
        ISCEHO = 0
        ISPFHO = 0
        ISPCHO = 0
        NIVEAU = ient1 +1
        IF (NIVEAU .GE. 26) THEN
          ISAUHO = 0
          IF (MSQHHO .GT. 0) ISAUHO = 1
        ELSE
          IF (MSQHHO .GT. 0) THEN
            write(ioimp,*) 'HHOPIL(1) : SAUV HHO non prevu a ce niveau'
            RETURN
          END IF
        END IF

C= 2 = VERIFICATIONS ANALYSE IMODELS = SAUVER/REST = DBG ===============
      ELSE IF (iopt .EQ. 2) THEN
        imHHO = ient1
        IF (imHHO.GT.0) THEN
          IF (ISAUHO.NE.1 .AND. ISAUHO.NE.2) THEN
            write(ioimp,*) 'HHOPIL(2) : SAUve HHO non prevu',ISAUHO
            RETURN
          ENDIF
        ENDIF

C= 3 = STOCKAGE DES MAILLAGES = SAUVER =================================
      ELSE IF (iopt .EQ. 3) THEN
c-dbg        write(ioimp,*) 'HHOPIL(3) :',isauho
        IF (ISAUHO .NE. 1) RETURN
        ICOLAC = ient1
        IIICHA = ient2
        itlacc = icolac.KCOLA(1)
        ilisse = icolac.ILISSG
        iun    = 1
C*        SEGACT,ilisse*MOD <- Fait en amont de l'appel 
        ISPCHO = 4 + NFAMAX + NCEMAX
        jg = ISPCHO
        SEGINI,mlenti
        jg1 = 0
        mlenti.lect(jg1+1) = MSQHHO
        mlenti.lect(jg1+2) = MCEHHO
        mlenti.lect(jg1+3) = MPFHHO
        mlenti.lect(jg1+4) = MPCHHO
        jg1 = jg1 + 4
        DO i = 1, NFAMAX
          mlenti.lect(jg1+i) = MAFHHO(i)
        END DO
        jg1 = jg1 + NFAMAX
        DO i = 1, NCEMAX
          mlenti.lect(jg1+i) = MACHHO(i)
        END DO
        jg1 = jg1 + NCEMAX
c-dbg        write(ioimp,*) ISPCHO,jg1,mlenti.lect(/1)
        if (jg1.ne.mlenti.lect(/1)) call erreur(5)
        DO i = 1, jg1
          ip = mlenti.lect(i)
          IF (ip.GT.0) then
            CALL AJOUN(itlacc,ip,ilisse,iun)
            IF (IIICHA.EQ.1) ip = -ip
            mlenti.lect(i) = ip
          ELSE
            mlenti.lect(i) = 0
          ENDIF
        END DO
        ISCEHO = mlenti

        ISPFHO = 8 + (1+NFAMAX) + (1+NCEMAX) + (2*NFAMAX)
        jg = ISPFHO
        SEGINI,mlenti
        jg1 = 0
        mlenti.lect(jg1+1) = IDIHHO
        mlenti.lect(jg1+2) = IFOHHO
        mlenti.lect(jg1+3) = NUFHHO
        mlenti.lect(jg1+4) = NFAHHO
        mlenti.lect(jg1+5) = NUCHHO
        mlenti.lect(jg1+6) = NCEHHO
        mlenti.lect(jg1+7) = NISFHO
        mlenti.lect(jg1+8) = NISCHO
        jg1 = jg1 + 8
        DO i = 0, NFAMAX
          mlenti.lect(jg1+1+i) = NBFHHO(i)
        END DO
        jg1 = jg1 + 1+NFAMAX
        DO i = 0, NCEMAX
          mlenti.lect(jg1+1+i) = NBCHHO(i)
        END DO
        jg1 = jg1 + 1+NCEMAX
        DO i = 1, NFAMAX
          mlent2 = LOFHHO(i)
          if (mlent2.gt.0) then
            segact,mlent2
            mlenti.lect(jg1+1) = mlent2.lect(1)
            mlenti.lect(jg1+2) = mlent2.lect(2)
            segdes,mlent2
          else
            mlenti.lect(jg1+1) = -999
            mlenti.lect(jg1+2) = -999
          endif
          jg1 = jg1 + 2
        END DO
c-dbg        write(ioimp,*) ISPCHO,jg1,mlenti.lect(/1)
        if (jg1.ne.mlenti.lect(/1)) call erreur(5)
        ISSQHO = mlenti

        ISAUHO = 2

C= 4 = ECRITURE EFFECTIVE DES MAILLAGES = SAUVER =======================
      ELSE IF (iopt .EQ. 4) THEN
c-dbg        write(ioimp,*) 'HHOPIL(4) :',isauho,ient1,ient2
c-dbg        IF (ISAUHO.NE.2.AND.isauho.ne.0) write(ioimp,*) 'Attention ?'
        IOSAU = ient1
        IFORM = ient2
        NMH = 3
        ILENA(1) = ISAUHO
        ILENA(2) = 0
        ILENA(3) = 0
        IF (ISAUHO.EQ.2) THEN
          ILENA(2) = ISPCHO
          ILENA(3) = ISPFHO
        ENDIF
        CALL ECDIFE(IOSAU,NMH,ILENA,IFORM)
c-dbg        write(ioimp,*) 'SAUve hHO :',(ilena(i),i=1,nmh)

        IF (ISAUHO.NE.2) RETURN
        NMH    = ISPCHO
        mlenti = ISCEHO
        CALL ECDIFE(IOSAU,NMH,mlenti.lect(1),IFORM)
        NMH    = ISPFHO
        mlenti = ISSQHO
        CALL ECDIFE(IOSAU,NMH,mlenti.lect(1),IFORM)

C= 5 = LECTURE EFFECTIVE DES MAILLAGES = REST ==========================
      ELSE IF (iopt .EQ. 5) THEN
c-dbg        write(ioimp,*) 'HHOPIL(5) :',isauho,ient1,ient2
        IORES = ient1
        IFORM = ient2
        NMH = 3
        CALL LFCDIE(IORES,NMH,ILENA,iretou,IFORM)
        IF (iretou.NE.0) THEN
          write(ioimp,*) 'Erreur lors de la lecture'
          RETURN
        ENDIF
c-dbg        write(ioimp,*) 'RESt hHO :',(ilena(i),i=1,nmh)
        ISAUHO = ILENA(1)
        IF (ISAUHO.NE.2) RETURN

        jg = ILENA(2)
        SEGINI,mlenti
        CALL LFCDIE(IORES,jg,mlenti.lect(1),iretou,IFORM)
        IF (iretou.NE.0) THEN
          write(ioimp,*) 'Erreur lors de la lecture'
          RETURN
        ENDIF
c-dbg        write(ioimp,*) 'RESt hHO :',(lect(i),i=1,jg)
        ISCEHO = mlenti

        jg = ILENA(3)
        SEGINI,mlenti
        CALL LFCDIE(IORES,jg,mlenti.lect(1),iretou,IFORM)
        IF (iretou.NE.0) THEN
          write(ioimp,*) 'Erreur lors de la lecture'
          RETURN
        ENDIF
c-dbg        write(ioimp,*) 'RESt hHO :',(lect(i),i=1,jg)
        ISSQHO = mlenti
        jg1 = 0
        IDIHHO = mlenti.lect(jg1+1)
        IFOHHO = mlenti.lect(jg1+2)
        NUFHHO = mlenti.lect(jg1+3)
        NFAHHO = mlenti.lect(jg1+4)
        NUCHHO = mlenti.lect(jg1+5)
        NCEHHO = mlenti.lect(jg1+6)
        NISFHO = mlenti.lect(jg1+7)
        NISCHO = mlenti.lect(jg1+8)
        jg1 = jg1 + 8
        DO i = 0, NFAMAX
          NBFHHO(i) = mlenti.lect(jg1+1+i)
        END DO
        jg1 = jg1 + 1+NFAMAX
        DO i = 0, NCEMAX
          NBCHHO(i) = mlenti.lect(jg1+1+i)
        END DO
        jg1 = jg1 + 1+NCEMAX
        DO i = 1, NFAMAX
          mlent2 = mlenti.lect(jg1+1)
          if (mlent2.NE.-999) then
            jg = 2
            segini,mlent2
            mlent2.lect(1) = mlenti.lect(jg1+1)
            mlent2.lect(2) = mlenti.lect(jg1+2)
            segdes,mlent2
          endif
          LOFHHO(i) = mlent2
          jg1 = jg1 + 2
        END DO
        if (jg1.ne.mlenti.lect(/1)) call erreur(5)

C= 6 = STOCKAGE DES MAILLAGES = RESTITUER ==============================
      ELSE IF (iopt .EQ. 6) THEN
        NIVEAU = ient1 + 1
c-dbg        write(ioimp,*) 'HHOPIL(6) :',isauho,niveau
        IF (NIVEAU.LT.26) RETURN
        IF (ISAUHO .NE. 2) RETURN
        ICOLAC = ient2
        itlac1 = icolac.KCOLA(1)
        ilisse = icolac.ILISSG
        iun    = 1
C*        SEGACT,ilisse*MOD <- Fait en amont de l'appel 
        mlenti = ISCEHO
        SEGACT,mlenti*MOD
        jg1 = 4 + NFAMAX + NCEMAX
c-dbg        if (jg1.ne.ISPCHO) write(ioimp,*) 'HHOPIL(6) : ISPCHO ??'
        DO i = 1, jg1
          ip = mlenti.lect(i)
          IF (ip.GT.0) then
            mlenti.lect(i) = itlac1.itlac(ip)
          ELSE
            mlenti.lect(i) = 0
          ENDIF
        END DO

        jg1 = 0
        MSQHHO = mlenti.lect(jg1+1)
        MCEHHO = mlenti.lect(jg1+2)
        MPFHHO = mlenti.lect(jg1+3)
        MPCHHO = mlenti.lect(jg1+4)
        jg1 = jg1 + 4
        DO i = 1, NFAMAX
          MAFHHO(i) = mlenti.lect(jg1+i)
        END DO
        jg1 = jg1 + NFAMAX
        DO i = 1, NCEMAX
          MACHHO(i) = mlenti.lect(jg1+i)
        END DO
        jg1 = jg1 + NCEMAX

        ISSQHO = mlenti
        ISPCHO = jg1

        IRESHO = 1

C= 9 = REMISE A ZERO ET MENAGE DE SEGMENTS =============================
c* Remise a zero et Menage de segments
      ELSE IF (iopt.EQ.9) THEN
        mlenti = ISSQHO
        IF (mlenti.GT.0) SEGSUP,mlenti
        mlenti = ISCEHO
        IF (mlenti.GT.0) SEGSUP,mlenti

        ISAUHO = -99
        IRESHO = -99
        ISSQHO = -99
        ISCEHO = -99
        ISPFHO = 0
        ISPCHO = 0

C= . = OPTION NON PREVUE ===============================================
      ELSE
        write(ioimp,*) 'HHOPIL : option ',iopt,' inconnue'
        call erreur(5)
      ENDIF

c-dbg      write(ioimp,*) 'HHOPIL S(',iopt,') :',ISAUHO,IRESHO,
c-dbg     &               '-',ISSQHO,ISCEHO,ISPFHO,ISPCHO

      RETURN
      END