C NTAP12    SOURCE    CHAT      05/01/13    02:01:57     5004           
      SUBROUTINE NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP)                                                  
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
-INC TMXMAT                                                                     
-INC SMLENTI                                                                    
-INC CCOPTIO                                                                    
-INC SMLREEL                                                                    
      POINTEUR MLREE4.MLREEL,MLREE5.MLREEL,MLREE6.MLREEL                        
      MXMAT=MCP                                                                 
      MXMA1=MCQ                                                                 
      MXMA2=MVDU                                                                
      MXMA3=MVDL                                                               
      JG=M                                                                      
      SEGINI MLREEL                                                             
      DO 1 J=1,M                                                                
         IF (XMAT(J,II).EQ.0.D0) THEN                                           
        PROG(J)=MXMA1.XMAT(J,II)*MXMA2.XMAT(II,KK)*MXMA2.XMAT(II,KK-1)                                          
         ELSE                                                                   
        PROG(J)=XMAT(J,II)*MXMA3.XMAT(II,KK)*MXMA3.XMAT(II,KK-1)           
          ENDIF                                                                  
    1 CONTINUE                                                                  
*  CONSTRUCTION DE LA MATRICE IDENTITE                                          
      LDIM1=M                                                                   
      LDIM2=M                                                                   
      SEGINI MXMAT,MXMA2                                                        
      DO 2 I=1,M                                                                
           XMAT(I,I)=1                                                          
    2 CONTINUE                                                                  
      XNORM2=0.D0                                                               
      DO 3 I=1,M                                                                
          XNORM2=PROG(I)**2+XNORM2                                              
    3 CONTINUE                                                                  
      CALL XITY(PROG,PROG,M,MXMA2.XMAT)                                         
      XNORM2=1./XNORM2                                                          
      CALL REEMAT(XNORM2,MXMA2.XMAT,M,M)                                        
      CALL ADDIMA(XMAT,MXMA2.XMAT,M,M,2)                                        
      MP=MXMAT                                                                  
      IF(IIMPI.EQ.1799)THEN                                                     
      MXMAT=MP                                                                  
      WRITE(IOIMP,'('' MATRICE DE PROJECTION'')')                               
      DO 200 I=1,M                                                              
         WRITE(IOIMP,'('' LIGNE  '',I2)')I                                     
         DO 200 J=1,M                                                          
            WRITE(IOIMP,'(1X,E12.5)')XMAT(I,J)                                 
  200 CONTINUE                                                                  
      ENDIF                                                                     
      RETURN                                                                    
      END