C NTAP21    SOURCE    CHAT      05/01/13    02:02:08     5004           
      SUBROUTINE NTAP21(IVFP,IVFQ,IVLAMB,IVB,IBU,IBL,                                                   
     * NPDR,N,MCP,MCQ,M,MVDU,MVDL,ITI,ITK)                                      
*                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      REAL*8 NORMP,NORMPM                                                     
      LOGICAL ADMI,UNAD                                                         
-INC CCOPTIO                                                                    
-INC CCREEL                                                                     
-INC SMLREEL                                                                    
-INC TMXMAT                                                                     
-INC SMLENTI                                                                    
      POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
      POINTEUR MLREE6.MLREEL,MLREE7.MLREEL,MLREE8.MLREEL                        
*                                                                               
      UNAD=.FALSE.                                                              
      VFPMIN=XGRAND                                                             
      NORMPM=XGRAND                                                           
      N11=N+1                                                                   
      MLENT1=ITI                                                                
      MLENT2=ITK                                                                
      LDIM1=NPDR                                                                
      LDIM2=2                                                                   
      SEGINI MXMAT,MXMA1                                                              
      MXMA2=MVDU
      MXMA3=MVDL
      SEGACT MXMA2,MXMA3                                                                 
      DO 1 I=1,NPDR                                                             
        XMAT(I,1)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)                  
        XMAT(I,2)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I))
        MXMA1.XMAT(I,1)=MXMA3.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)                  
        MXMA1.XMAT(I,2)=MXMA3.XMAT(MLENT1.LECT(I),MLENT2.LECT(I))                    
    1 CONTINUE
      MLREEL=IBU
      SEGACT MLREEL                                                                   
      JG=PROG(/1)                                                                    
      SEGINI MLREE6,MLREE7
      SEGINI MLREE4,MLREE5
      SEGINI MLREE2,MLREE3
      IBBU=MLREE2
      IBBL=MLREE3                                                             
      DO 2 I=0,(2**NPDR)-1                                                      
      ADMI=.TRUE.                                                               
*                                                                               
*  SAUVEGARDE DE IBU,IBL
*
         MLREEL=IBU
         MLREE1=IBL
         SEGACT MLREEL,MLREE1                                                                                      
         DO 10 J=1,N11                                                          
           MLREE4.PROG(J)=PROG(J)
           MLREE5.PROG(J)=MLREE1.PROG(J)                                               
   10    CONTINUE                                                               
*                                                                               
         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                                                               
         DO 4 J=1,NPDR                                                          
           MLREE4.PROG(MLENT1.LECT(J))=XMAT(J,LECT(J)+1)
           MLREE5.PROG(MLENT1.LECT(J))=MXMA1.XMAT(J,LECT(J)+1)                       
    4    CONTINUE                                                               
*                                                                               
*  TEST SI IBU,IBL EST UN PT DUAL ADMISSIBLE                                         
*
         JG=MLREE4.PROG(/1)
         SEGINI MLREEL,MLREE1
         DO 41 J=1,N11
            PROG(J)=1.D0/MLREE4.PROG(J)
            MLREE1.PROG(J)=1.D0/MLREE5.PROG(J)
   41    CONTINUE
         MXMA2=MCP
         MXMA3=MCQ
         CALL MATVE1(MXMA2.XMAT,PROG,M,N11,MLREE6.PROG,2)
         CALL MATVE1(MXMA3.XMAT,MLREE1.PROG,M,N11,MLREE7.PROG,2)
         MLREE8=IVB
         NORMP=0.D0                                                             
         DO 42 J=1,M                                                            
          DIF=MLREE6.PROG(J)+MLREE7.PROG(J)-MLREE8.PROG(J)                      
          IF(DIF.GT.0.D0)THEN                                                   
              IF(UNAD) GO TO 2                                                  
              ADMI=.FALSE.                                                      
              NORMP=NORMP+(DIF**2)                                               
          ENDIF                                                                 
   42    CONTINUE                                                               
*                                                                               
* CALCUL DE LA VALEUR DE LA FONCTION PRIMALE VFP DE X                           
*                                                                               
         IF(ADMI) THEN                                                          
      IF(IIMPI.EQ.1799)                                                         
     *WRITE(IOIMP,FMT='( '' POINT  ADMISSIBLE '' )')
            MLREE6=IVFP
            MLREE7=IVFQ
            SEGACT MLREE6,MLREE7                            
            VFP=0.                                                              
            DO 5 J = 1,N11                                                      
              VFP=VFP+(PROG(J)*MLREE6.PROG(J))+                            
     *         (MLREE1.PROG(J)*MLREE7.PROG(J))                                    
    5       CONTINUE                                                            
            UNAD=.TRUE.                                                         
*                                                                               
* RECHERCHE DU MIN  DE VFP POUR LES PTS ADMISSIBLES                             
*                                                                               
         IF(VFP.LT.VFPMIN) THEN                                                 
            VFPMIN=VFP                                                          
            DO 20 J=1,N11                                                       
              MLREE2.PROG(J)=MLREE4.PROG(J)
              MLREE3.PROG(J)=MLREE5.PROG(J)                                     
   20       CONTINUE                                                            
         ENDIF                                                                  
         ENDIF                                                                  
*                                                                               
* RECHERCHE  DU PT QUI RESPECTE AU MIEUX LES CONTRAINTES SI PAS DE SOL          
*                                                                               
         IF(.NOT.UNAD)THEN                                                      
         IF(NORMP.LT.NORMPM) THEN                                             
            NORMPM=NORMP                                                      
            DO 21 J=1,N11                                                       
              MLREE2.PROG(J)=MLREE4.PROG(J)
              MLREE3.PROG(J)=MLREE5.PROG(J)                                     
   21       CONTINUE                                                            
         ENDIF                                                                  
         ENDIF                                                                  
    2 CONTINUE                                                                  
      IF(.NOT.UNAD) THEN                                                        
      IF(IIMPI.EQ.1799)                                                         
     *WRITE(IOIMP,FMT='( '' PAS DE POINT ADMISSIBLE '' )')                      
      ENDIF                                                                     
      MLREEL=IBBU
      MLREE1=IBBL
      MLREE2=IBU
      MLREE3=IBL
      SEGACT MLREEL,MLREE1,MLREE2,MLREE3
      DO 30 I=1,N11
         MLREE2.PROG(I)=PROG(I)
         MLREE3.PROG(I)=MLREE1.PROG(I)
   30 CONTINUE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X DANS ETAP21
     * = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X DANS ETAP21
     * = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11)                                                                    
      RETURN                                                                    
      END