C IPLNU2    SOURCE    FANDEUR   11/07/19    21:16:12     7039           

        SUBROUTINE IPLNU2(INUA,ITR1,ITR2,MAX1,IVAL)
c
c fonction
c     cette sous routine interpole une fonction de n variables dont
c     certains couple (x,f(x)) on ete stockés dans un objet de type
c     nuage. On utilise une methode des elements diffus. En chaque 
c     point on cheche la forme lineaire qui minimise la distance ponderée 
c     de l'hyperplan plan au point du nuage. La valeur obtenue est 
c     celle de la forme lineaire au point considere.
c
c variables
c     inua pointeur sur l'objet de type nuage
c     itr1 pointeur sur le segment mtr1 de iplnu2.eso
c                   qui contient une correspondance entre la position
c                   des variables dans les tableua du nuage
c     itr2  pointeur sur le segment mtr2 qui contient les variables x
c                    dans xi et les valeurs f(x) dans yi
c     max1  pointeur sur l'objet qui contient le max des composantes du nuage
c
c appelé par iplnu2.eso
c date 05/07/94
c auteur A de Gayffier 
c langage fortran 77 + esope
c                                
      IMPLICIT INTEGER(I-N)
      IMPLICIT    REAL*8(A-H,O-Z) 
      PARAMETER ( GRAND = 1.D50) 
-INC CCOPTIO
-INC SMNUAGE
      SEGMENT MTR1
         INTEGER IADD(NNMM)
      ENDSEGMENT
      SEGMENT MTR2
         REAL*8  XI(NN),YI(MM)
      ENDSEGMENT
      SEGMENT MA 
*     ce segment contient la matrice du syteme lineaire
*     a contient les termes et indx contient les indices de permutation
*     une fois la decomposition effectuée 
         REAL*8 A(NN+1,NN+1),D
         INTEGER INDX(NN+1)
      ENDSEGMENT
      SEGMENT MB 
         REAL*8 B(NN+1,MM)
      ENDSEGMENT
      SEGMENT MDX
          REAL*8 DX(NN+1)
      ENDSEGMENT
      SEGMENT MDIS
          REAL*8 DIMINI(NN+1)
          INTEGER NNBCP(NN+1)
      ENDSEGMENT
      SEGMENT MAX1
          REAL*8 MAXV(NNMM)
      ENDSEGMENT
c
c   on active tous les segments necessaires
c
      MNUAGE = INUA   
c      SEGACT ,MNUAGE
c
      NVAR   = NUAPOI(/1)
      DO 10 I=1,NVAR 
        NUAVFL = NUAPOI(I)
        SEGACT ,NUAVFL
 10   CONTINUE
*
      NBCOUP = NUAFLO(/1)
*
      IF (NBCOUP .EQ. 0) THEN
*    nuage vide operation impossible
        CALL ERREUR(680)
        SEGDES ,MNUAGE
        RETURN
      ENDIF
*
      MTR1 = ITR1
      MTR2 = ITR2
      SEGACT MTR1,MTR2*MOD
c      SEGACT ,MAX1
      NN = XI(/1)
      MM = YI(/1)
      NNMM = IADD(/1)
c
c      IF ( NVAR .NE. (NN+MM)) THEN
c        write(ioimp,*) 'ERREUR DANS LA DIMENSION DES MTR'
c      ENDIF
c
      SEGINI ,MA,MB,MDIS
c    initialisation du tableau pour stocker les distances
*    on place des valeurs tres grandes
      DO 1 I=1,NN+1
        DIMINI(I)= GRAND
 1    CONTINUE
c
c   calcul de la distance cararctéristique du nuage
c
      DO 60 I=1,NBCOUP
        SUM = 0.D0
        DO 30 J=1,NN  
           NUAVFL = NUAPOI(IADD(J))
c        on divise les distances par les maximums de chaque composante
           DUM = (XI(J)-NUAFLO(I))/MAXV(IADD(J))
           SUM = SUM + DUM*DUM
 30     CONTINUE
        DIST = SQRT(SUM)
c   stockage des plus petites valeurs
        DO 50 J=1,NN+1
           IF ( DIST .LT. DIMINI(J) )THEN
             DO 40 K=NN+1,J+1,-1
               DIMINI(K)=DIMINI(K-1)
               NNBCP(K)=NNBCP(K-1)
 40          CONTINUE
             DIMINI(J)=DIST
             NNBCP(J)=I
             GOTO 60
           ENDIF
 50     CONTINUE
 60   CONTINUE
c
      DCARA =0.D0
      DO 65 J=1,NN+1
        DCARA = DCARA + DIMINI(J)
  65  CONTINUE
      DCARA = DCARA / (NN+1.D0)
c
c   affichage de mise au point avec opti impi 9022 ;
c
      IF (IIMPI .EQ. 9022) WRITE(6,1001) DCARA
      IF (IIMPI .EQ. 9022) THEN
           WRITE(ioimp,1002) (NN+1)
           write(ioimp,1005) (DIMINI(I),I=1,NN+1)
*               boucle sur les composantes
           DO 67 I=1,NN 
             NUAVFL = NUAPOI(IADD(I))              
             WRITE(ioimp,1004) NUANOM(IADD(I))
             write(ioimp,1003) (NUAFLO(NNBCP(J))/MAXV(IADD(I)),J=1,NN+1)
             WRITE(ioimp,*)
   67      CONTINUE
           DO 68 I=NN+1,NNMM
             NUAVFL = NUAPOI(IADD(I))              
             WRITE(ioimp,1004) NUANOM(IADD(I))
             write(ioimp,1003) (NUAFLO(NNBCP(J))/MAXV(IADD(I)),J=1,NN+1)
             WRITE(ioimp,*)
   68      CONTINUE
      ENDIF  
 1001 FORMAT('La distance caractéristique vaut ',G10.4)
 1002 FORMAT('Distance et coordonées des',1X,I2,1X,'points 
     &        les plus proches sont')
 1003 FORMAT(30(G10.4,1X))
 1004 FORMAT('Composante ',A)
 1005 FORMAT('Distance au point courant:',/,30(G10.4))
*
      SEGSUP ,MDIS
c
c On sort l'initialisation de ce segment de la boucle
      SEGINI MDX
c
c   boucle sur les points du nuage (nbcoup)
c
      DO 110 I=1,NBCOUP
c  
c     boucle sur les monomes du polynome d'interpolation (1,x,y,...)
c  remplissage complet de DX (segment MDX)
        DX(1)=1.D0
        SUM = 0.D0
        DO 70 J=2,(NN+1)  
           NUAVFL = NUAPOI(IADD(J-1))  
c        on divise les distances par les maximums de chaque composante
           DX(J)=(XI(J-1)-NUAFLO(I))/MAXV(IADD(J-1))
           SUM = SUM + DX(J)*DX(J)
 70     CONTINUE
        DIST = SQRT(SUM)
C
*  fonction de ponderation de la distance
        Z = DIST/DCARA
        IF (IVAL .EQ. 1 ) THEN
          WDED = 1.D0/(Z+1.D0)
        ELSE
          WDED = EXP(-Z*Z)
        ENDIF
c       remplissage de a et de b
        DO 100 J=1,(NN+1)
          r_z = WDED*DX(J)
          DO 80 K=1,(NN+1)
C*            A(J,K) = A(J,K) + WDED*DX(J) * DX(K)
              A(J,K) = A(J,K) + r_z * DX(K)
 80       CONTINUE
          DO 90 K=1,MM
              NUAVFL = NUAPOI(IADD(NN+K))
C*            B(J,K)=B(J,K) + WDED*DX(J)*NUAFLO(I)
              B(J,K)=B(J,K) + r_z * NUAFLO(I)
 90      CONTINUE
c
 100    CONTINUE
c
 110  CONTINUE
c
      SEGSUP,MDX
c
c  phase de resolution
c
c  on resoud a.x=b pp fois
c
       CALL IPLNU3(MA)

       DO 120 I=1,MM
         CALL IPLNU4(MA,MB,I)
 120   CONTINUE        
c
c   on replace le resultat dans mtr2
c   dans les B(*,I) sont stockees les dérivées partielles de la fonction
c
        DO 130 I=1,MM
          YI(I)=B(1,I)
 130    CONTINUE
c
c  on ferme et on détruit les segments activés
c
        DO 140 I=1,NVAR 
          NUAVFL = NUAPOI(I)
          SEGDES ,NUAVFL
 140    CONTINUE
c
c        SEGDES MNUAGE
        SEGSUP MA,MB
c
        RETURN
        END