C IPLNU1    SOURCE    PV        09/03/12    21:25:29     6325           
      SUBROUTINE IPLNU1(INUA)
c
c fonction
c     cette sous routine interpole une fonction de n variables dont
c     certains couples (x,f(x)) ont été stockés dans un objet de type
c     nuage
c
c variables
c     inua pointeur sur l'objet de type nuage
c     iadd contient la correspondance entre les numeros de mtr2 de
c          1 à nn+mm et ceux du nuage.
c     mtr2 contient les valeurs des variables maitres dans xi et les
c          valeurs esclaves dans yi
c
c appelé par interpol qui vient de l'opérateur ipol
c
c auteur a de gayffier
c date  05/07/94
c
c langage esope+fortran 77
c
      IMPLICIT INTEGER(I-N)
      IMPLICIT    REAL*8(A-H,O-Z)
      PARAMETER (TINY=1.D-20)
      LOGICAL FLAG
-INC SMNUAGE
-INC SMCHAML
-INC CCOPTIO
-INC SMCHPOI
      SEGMENT MTR1
         INTEGER IADD(NNMM)
      ENDSEGMENT
      SEGMENT MTR2
         REAL*8  XI(NN),YI(MM)
      ENDSEGMENT
      SEGMENT MAX1
         REAL*8  MAXV(NNMM)
      ENDSEGMENT
      CHARACTER*5 CLE(2)
      DATA CLE /'GAUSS','RATIO'/
c
c   option pour la fonction de ponderation
c
      CALL LIRMOT(CLE,2,IVAL,0)
      IF (IVAL .EQ. 0) IVAL = 1
c
      MNUAGE = INUA
      SEGACT ,MNUAGE

      NNMM = NUANOM(/2)
      SEGINI ,MAX1

c    recherche du maximum de chaque paramètre

        DO 20 K=1,NNMM
           MAXV(K) = 0
           NUAVFL = NUAPOI(K)
           SEGACT ,NUAVFL
           NBCOUP = NUAFLO(/1)
           MAXV(K)=TINY
           DO 10 J=1,NBCOUP
              IF(MAXV(K).LT.ABS(NUAFLO(J))) THEN
                 MAXV(K) = ABS(NUAFLO(J))
              ENDIF
  10    CONTINUE
  20    CONTINUE
c
      CALL LIROBJ('CHPOINT',IPOI,0,IRETOU)
      IF ( IRETOU .EQ. 1 ) GOTO 210
      CALL LIROBJ('MCHAML',ICHML,0,IRETOU)
      IF ( IRETOU .EQ. 0 ) THEN
c   pas d'argument correct trouvé: erreur
        CALL QUETYP(MOTERR(1:8),0,IRETOU)
        IF(IRETOU.NE.0) THEN
            CALL ERREUR(39)
        ELSE
            CALL ERREUR(533)
        ENDIF
        RETURN
      ENDIF
c--------------------cas d'un mchml---------------------
c
c
      MCHELM = ICHML
      SEGACT MCHELM
c      creation du chapeau du chamelem resultat
      SEGINI ,MCHEL1 = MCHELM
c
      N1 = ICHAML(/1)   
c
c boucle sur les chamelems elementaires
c
      DO 200 I=1,N1
        MCHAML = ICHAML(I)
        SEGACT MCHAML
c      calcul des dimensions nn et pp
        NNMM = 0
        SEGINI MTR1
        ITR1 = MTR1
        NN = NOMCHE(/2)
        MM = NUANOM(/2) - NN
c      initialisation du nouveau sous chamelem
        N2 = MM
        SEGINI ,MCHAM1
        MCHEL1.ICHAML(I) = MCHAM1
c
c        on verifie que les noms des composantes du chamelem sont
c        dans le nuage et on rempli iadd
c
        DO 110 J=1,NOMCHE(/2)
          IF ( TYPCHE(J) .NE. 'REAL*8' ) THEN
           MOTERR(1:8) = NOMCHE(J)
           MOTERR(9:13) = 'CHAMP'
           CALL ERREUR(681)
*
*    'la composante',nomche(j),'du chamelem''n est pas scalaire'*
           SEGDES MCHAML,MCHELM,MNUAGE
           SEGSUP MTR1,MCHAM1,MCHEL1
           RETURN
          ENDIF
*
          DO 100 K=1,NUANOM(/2)
            IF (NUANOM(K) .EQ. NOMCHE(J)) THEN
               IADD(**)=K
               NNMM = IADD(/1)
             ENDIF
 100      CONTINUE
          IF ( NNMM .NE. J ) THEN
c        une des composantes du champ n'est pas un composante du nuage
           CALL ERREUR(682)
           SEGDES MCHAML,MCHELM,MNUAGE
           SEGSUP MTR1,MCHAM1,MCHEL1
*           return
          ENDIF
  110     CONTINUE
c
c         on recupere les composantes du nuage qui ne sont pas celles
c         du chamelem
c
        DO 130 J=1,NUANOM(/2)
          IF ( NUATYP(J) .NE. 'FLOTTANT' ) THEN
            MOTERR(1:8) = NUANOM(J)
            MOTERR(9:13) = 'NUAGE'
            CALL ERREUR(681)
*      'la composante', nuanom(j), 'du nuage', 'n est pas scalaire'
            SEGDES MCHAML,MCHELM,MNUAGE
            SEGSUP MTR1,MCHAM1,MCHEL1
            RETURN
          ENDIF
          FLAG = .TRUE.
          DO 120 K=1,NOMCHE(/2)
            IF (NUANOM(J) .EQ. NOMCHE(K)) THEN
               FLAG = .FALSE.
            ENDIF
  120     CONTINUE
          IF (FLAG) THEN
c          la composante du nuage n'est pas dans le chamelem
            IADD(**) = J
            NNMM = IADD(/1)
           ENDIF
  130   CONTINUE
        IF ( NNMM .NE. NUANOM(/2)) THEN
          CALL ERREUR(682)
*        'incoherence entre les composantes du nuage et du champ'
          SEGDES MCHAML,MCHELM,MNUAGE
          SEGSUP MTR1,MCHAM1,MCHEL1
          RETURN
        ENDIF
c
c      on rempli les types et le nom du nouveau sous chamelem
c
        DO 135 J=1,MM
          MCHAM1.TYPCHE(J)='REAL*8'
          MCHAM1.NOMCHE(J)=NUANOM(IADD(NN+J))
  135   CONTINUE
c
c   activation de tous les melval
c
         DO 136 J=1,NN
          MELVAL = IELVAL(J)
          SEGACT ,MELVAL
  136   CONTINUE
c
c    on recupere le nombre d'élément et le nombre de points par element
c
        N1PTEL = VELCHE(/1)
        N1EL = VELCHE(/2)
        N2PTEL = 0
        N2EL = 0
c
        DO 138 J=1,MM
          SEGINI MELVAL
          MCHAM1.IELVAL(J) = MELVAL
  138   CONTINUE
c
c    boucle sur chaque point de gauss
c
        DO 170 J=1,N1EL
        DO 160 K=1,N1PTEL
           SEGINI ,MTR2
           ITR2 = MTR2
c
c        boucle sur les composantes pour remplir le tableau xi
c        qui contient les valeurs des variables maitres
           DO 140 L=1,NN
             MELVAL = IELVAL(L)
             XI(L) = VELCHE(K,J)
  140      CONTINUE
c
c        on interpole le nuage pour les valeurs xi
c
           CALL IPLNU2(INUA,ITR1,ITR2,MAX1,IVAL)
           IF ( IERR .NE. 0 ) THEN
               SEGDES MCHAML,MCHELM
               DO 145 L=1,MCHAM1.IELVAL(/1)
                   MELVAL = MCHAM1.IELVAL(L)
                   SEGSUP MELVAL
  145          CONTINUE
               SEGSUP MCHAM1,MCHEL1,MTR1,MTR2
               RETURN
           ENDIF
c
c        remplissage des résultats stockés dasn yi
c
           DO 150 L=1,MM
             MELVAL = MCHAM1.IELVAL(L)
             VELCHE(K,J) = YI(L)
  150      CONTINUE
           SEGSUP ,MTR2
c
  160    CONTINUE
  170    CONTINUE
c
c   on desactive tout les segments melval
         DO 180 J=1,NN
          MELVAL = IELVAL(J)
          SEGDES ,MELVAL
  180   CONTINUE
c
        DO 190 J=1,MM
          MELVAL = MCHAM1.IELVAL(J)
          SEGDES ,MELVAL
  190   CONTINUE
         SEGDES ,MCHAML
         SEGDES ,MCHAM1
         SEGSUP ,MTR1
  200 CONTINUE
c
c fin de la boucle sur les sous champs mchaml
       ICH1 = MCHEL1
       SEGDES MNUAGE,MCHELM,MCHEL1
       SEGSUP MAX1
       CALL ECROBJ('MCHAML  ',ICH1)
       RETURN
c
c---------------cas du chpoint-----------------------
  210 CONTINUE
c
      MCHPOI = IPOI
      SEGACT MCHPOI
c
      SEGINI ,MCHPO1 = MCHPOI
      NSOUPO = IPCHP(/1)
c
c boucle sur les chpoints elementaire
      DO 280 I=1,NSOUPO
        MSOUPO = IPCHP(I)
        SEGACT MSOUPO
c
c  calcul de nn et mm
c
         NNMM=0
         SEGINI MTR1
         ITR1 = MTR1
         NN = NOCOMP(/2)
         MM = NUANOM(/2) - NN
c   initialisation du nouveau soupo
         NC = MM
         SEGINI MSOUP1
         MCHPO1.IPCHP(I)=MSOUP1
         MSOUP1.IGEOC = IGEOC
c
c  on verifie que les noms des composantes du chpoint sont
c        dans le nuage et on rempli iadd
c
        DO 230 J=1,NOCOMP(/2)
          DO 220 K=1,NUANOM(/2)
            IF (NUANOM(K) .EQ. NOCOMP(J)) THEN
               IADD(**)=K
               NNMM = IADD(/1)
             ENDIF
 220      CONTINUE
          IF ( NNMM .NE. J ) THEN
c        une des composantes du champ n'est pas un composante du nuage
           CALL ERREUR(682)
*          'incoherence entre les composantes du nuage et du champ'
           SEGDES MCHPOI,MSOUPO,MNUAGE
           SEGSUP MTR1,MCHPO1,MSOUP1
           RETURN
          ENDIF
  230     CONTINUE
c
c  on recupere les composantes du nuage qui ne sont pas dans le chpoint
c
        DO 250 J=1,NUANOM(/2)
          IF ( NUATYP(J) .NE. 'FLOTTANT' ) THEN
*            la composante du nuanom(j) du nuage n'estpas scalaire
           MOTERR(1:8) = NUANOM(J)
           MOTERR(9:13) = 'NUAGE'
           CALL ERREUR(681)
           SEGDES MCHPOI,MSOUPO,MNUAGE
           SEGSUP MTR1,MCHPO1,MSOUP1
           RETURN
         ENDIF
          FLAG = .TRUE.
          DO 240 K=1,NOCOMP(/2)
            IF (NUANOM(J) .EQ. NOCOMP(K)) THEN
               FLAG = .FALSE.
            ENDIF
  240     CONTINUE
          IF (FLAG) THEN
c          la composante du nuage n'est pas dans le chamelem
            IADD(**) = J
            NNMM = NNMM +1
           ENDIF
  250   CONTINUE
        IF ( NNMM .NE. NUANOM(/2)) THEN
          PRINT *, 'INCOHERENCE DANS LES COMPOSANTES'
        ENDIF
c
c   on rempli le noms des composantes du nouveau champ
c
        DO 255 J=1,MM
          MSOUP1.NOCOMP(J)=NUANOM(IADD(J+NN))
  255   CONTINUE
        MPOVAL = IPOVAL
        SEGACT MPOVAL
c      nouveau segment mpoval
        N = VPOCHA(/1)
        NC = MM
        SEGINI MPOVA1
        MSOUP1.IPOVAL = MPOVA1
c
c    boucle sur les points
c
        DO 270 J=1,N
          SEGINI MTR2
          ITR2 = MTR2
          DO 260 K=1,NN
            XI(K)=VPOCHA(J,K)
  260     CONTINUE
c
c   interpolation
c
          CALL IPLNU2(INUA,ITR1,ITR2,MAX1,IVAL)
c         en cas d'erreur on sort proprement
          IF ( IERR .NE. 0 ) THEN
               SEGDES MCHPOI,MSOUPO
               SEGSUP MCHPO1,MSOUP1,MPOVAL,MTR1,MTR2,MAX1
               RETURN
          ENDIF
c
          DO 265 K=1,MM
            MPOVA1.VPOCHA(J,K)=YI(K)
  265     CONTINUE
          SEGSUP ,MTR2
c
  270     CONTINUE
c   desactivation des segments
          SEGSUP,MTR1
          SEGDES ,MPOVAL
          SEGDES ,MSOUPO
          SEGDES ,MPOVA1,MSOUP1
c
  280 CONTINUE
c
      IP1 = MCHPO1
      SEGDES ,MCHPOI
      SEGDES ,MCHPO1
      SEGDES ,MNUAGE
      SEGSUP ,MAX1
      CALL ECROBJ('CHPOINT ',IP1)
c
      RETURN
      END