C NTAP17    SOURCE    CHAT      05/01/13    02:02:03     5004           
      SUBROUTINE NTAP17(IVFP,IVFQ,IVXU,IVXL,IVLAMB,IVB,IBU,IBL,VF0,                                               
     * NDR,N,MCP,MCQ,M,XL,XLL,ILOG1,NPDR,MVDU,MVDL,ITI,ITK,VFPMAX,
     * IVN,IVD)              
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                    
-INC SMLREEL                                                                    
-INC TMXMAT                                                                     
-INC SMLENTI                                                                    
      POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
      POINTEUR MLREE6.MLREEL,MLREE7.MLREEL                                                    
      LOGICAL ILOG1                                                             
      N11=N+1                                                                   
      VFPMAX=-1.D-20                                                               
      MLENT1=ITI                                                                
      MLENT2=ITK                                                                
      LDIM1=NPDR                                                                
      LDIM2=2                                                                   
      SEGINI MXMAT,MXMA3                                                              
      MXMA1=MVDU
      MXMA2=MVDL                                                                 
      DO 1 I=1,NPDR                                                             
         XMAT(I,1)=MXMA1.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)                  
         XMAT(I,2)=MXMA1.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)) 
         MXMA3.XMAT(I,1)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)                  
         MXMA3.XMAT(I,2)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I))                    
    1 CONTINUE                                                                  
*  SAUVEGARDE DE IVXU,IVXL
      MLREEL=IVXU
      MLREE1=IVXL
      MLREE6=IVFP                                                             
      MLREE7=IVFQ
      SEGACT MLREEL,MLREE1,MLREE6,MLREE7
      JG=PROG(/1)                                                                    
      SEGINI MLREE4,MLREE5
      IBBU=MLREE4
      IBBL=MLREE5
      SEGINI MLREE2,MLREE3
      IBU=MLREE2                                                                                                                     
      IBL=MLREE3                                                             
      DO 2 I=0,(2**NPDR)-1                                                      
      DO 10 J=1,JG                                                             
         MLREE4.PROG(J)=PROG(J)
         MLREE5.PROG(J)=MLREE1.PROG(J)                                                 
   10 CONTINUE
*                                                                               
******** CONVERSION DE I EN BINAIRE **************                              
*                                                                               
         K=I                                                                    
         JG=NPDR                                                                
         SEGINI MLENTI                                                          
         DO 3 J=NPDR-1,0,-1                                                     
            LECT(J+1)=INT(K/(2**J))                                             
            K=K-(2**J)*LECT(J+1)                                                
    3    CONTINUE                                                               
*                                                                               
*** DANS MLENTI(I) ON A LE CODAGE: 0 POUR X(K-1) POUR LA VARIABLE I             
*                                : 1 POUR X(K)                                  
*   QUI N'EST PAS FIXEE                                                         
*                                                                               
         DO 4 J=1,NPDR                                                          
            MLREE4.PROG(MLENT1.LECT(J))=XMAT(J,LECT(J)+1) 
            MLREE5.PROG(MLENT1.LECT(J))=MXMA3.XMAT(J,LECT(J)+1)                       
    4    CONTINUE
*                                                                               
* CALCUL DE LA VALEUR DE LA FONCTION PRIMALE VFP DE X                           
*                                                                               
         VFP=0.                                                                 
         DO 5 J = 1,N11
           X1=MLREE4.PROG(J)
           X2=MLREE5.PROG(J)
           IF(MLREE4.PROG(J).LT.1.D-15) X1=1.D-15
           IF(MLREE5.PROG(J).LT.1.D-15) X2=1.D-15                                                          
           VFP=VFP+(MLREE6.PROG(J)/X1)+(MLREE7.PROG(J)/X2)                                        
    5    CONTINUE
*                                                                               
*RECHERCHE DU MAX  DE VFP AUTOUR DU POINT COURANT                               
*                                                                               
         IF(VFP.GT.VFPMAX) THEN                                                 
            VFPMAX=VFP                                                          
            DO 20 J=1,N11                                                       
              MLREE2.PROG(J)=MLREE4.PROG(J)
              MLREE3.PROG(J)=MLREE5.PROG(J)
   20       CONTINUE                                                            
         ENDIF                                                                  
    2 CONTINUE                                                                  
      MLREE2=IBU
      MLREE3=IBL
      SEGACT MLREE2,MLREE3
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
     *ION = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
     *ION = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11)
*                                                             
************************************************************************        
*
      XLL=XL                                                                    
      XL=0.D0
      MLREEL=IVN
      MLREE1=IVD
      MLREE4=IVXU
      MLREE5=IVXL
      SEGACT MLREEL,MLREE1,MLREE4,MLREE5                                                                  
      DO 6 I = 1,N11
           X1=MLREE4.PROG(J)
           X2=MLREE5.PROG(J)
           IF(MLREE4.PROG(J).LT.1.D-15) X1=1.D-15
           IF(MLREE5.PROG(J).LT.1.D-15) X2=1.D-15                                                            
           XL=XL +(PROG(I)/X1)+(MLREE1.PROG(I)/X2)              
    6 CONTINUE
      MLREEL=IVB
      MLREE1=IVLAMB
      DO 7 I=1,M
        XL=XL+PROG(I)*MLREE1.PROG(I)
    7 CONTINUE
*
      ILOG1=.FALSE.                                                             
      IF( XL.GT.VFPMAX) THEN                                                    
         ILOG1= .TRUE.                                                          
      ELSE                                                                      
         IF( XLL.LT.XL)THEN                                                     
            ILOG1=.TRUE.                                                        
         ENDIF                                                                  
      ENDIF                                                                     
      IF( NDR.EQ.0) THEN                                                        
          ILOG1=.TRUE.                                                          
      ENDIF                                                                     
      NDR=NDR + 1                                                               
      RETURN                                                                    
      END