Download ntap13.eso

Back to the list

   1 : C NTAP13    SOURCE    CHAT      05/01/13    02:02:00     5004           
   2 :       SUBROUTINE NTAP13 (MP,MCP,MCQ,M,N,MVDU,MVDL,KK,II)                                             
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 : *                                                                               
   6 : *   MISE A JOUR DE LA MATRICE DE PROJECTION                                     
   7 : *                                                                               
   8 : -INC TMXMAT                                                                     
   9 : -INC SMLREEL                                                                    
  10 : -INC CCOPTIO                                                                    
  11 :       MXMAT=MCP                                                                 
  12 :       MXMA1=MCQ                                                                 
  13 :       MXMA2=MVDU                                                                
  14 :       MXMA3=MVDL                                                                
  15 :       JG=M                                                                      
  16 :       SEGINI MLREEL                                                             
  17 :       DO 1 J=1,M                                                                
  18 :       IF(XMAT(J,II).EQ.0.D0) THEN                                               
  19 :        PROG(J)=MXMA1.XMAT(J,II)*MXMA2.XMAT(II,KK)*MXMA2.XMAT(II,KK-1)                                             
  20 :       ELSE                                                                      
  21 :            PROG(J)=XMAT(J,II)*MXMA3.XMAT(II,KK)*MXMA3.XMAT(II,KK-1)                          
  22 :       ENDIF                                                                     
  23 :     1 CONTINUE                                                                  
  24 :       SEGINI MLREE1                                                             
  25 :       MXMAT=MP                                                                  
  25 :       CALL MATVE1( XMAT,PROG,M,M,MLREE1.PROG,2)                                 
  26 :       LDIM1=M                                                                   
  27 :       LDIM2=M                                                                   
  28 :       SEGINI MXMAT                                                              
  29 :       XX=0.D0                                                                   
  30 :       DO 2 I=1,M                                                                
  31 :       XX = MLREE1.PROG(I)*MLREE1.PROG(I) + XX                                   
  32 :     2 CONTINUE                                                                  
  32 :       CALL XITY(MLREE1.PROG,MLREE1.PROG,M,XMAT)                                 
  33 :       XX=1./XX                                                                  
  33 :       CALL REEMAT(XX,XMAT,M,M)                                                  
  34 :       MXMA1=MP                                                                  
  34 :       CALL ADDIMA(MXMA1.XMAT,XMAT,M,M,2)                                        
  35 :       MP=MXMA1                                                                  
  36 :       SEGSUP MLREEL,MLREE1                                                      
  37 :       RETURN                                                                    
  38 :       END                                                                       
  39 :  

© Cast3M 2003 - All rights reserved.
Disclaimer