Download etap14.eso

Back to the list

   1 : C ETAP14    SOURCE    CHAT      05/01/12    23:46:11     5004           
   2 :       SUBROUTINE ETAP14 (MP,II,M)                                               
   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 CCOPTIO                                                                    
   9 : -INC TMXMAT                                                                     
  10 : -INC SMLREEL                                                                    
  11 :       JG=M                                                                      
  12 :       SEGINI MLREEL                                                             
  13 :       PROG(II)=1.D0                                                             
  14 :       SEGINI MLREE1                                                             
  15 :       MXMAT=MP                                                                  
  15 :       CALL MATVE1( XMAT,PROG,M,M,MLREE1.PROG,2)                                 
  16 :       LDIM1=M                                                                   
  17 :       LDIM2=M                                                                   
  18 :       SEGINI MXMAT                                                              
  19 :       XX=0.D0                                                                   
  20 :       DO 2 I=1,M                                                                
  21 :       XX = MLREE1.PROG(I)*MLREE1.PROG(I) + XX                                   
  22 :     2 CONTINUE                                                                  
  22 :       CALL XITY(MLREE1.PROG,MLREE1.PROG,M,XMAT)                                 
  23 :       XX=1./XX                                                                  
  23 :       CALL REEMAT(XX,XMAT,M,M)                                                  
  24 :       MXMA1=MP                                                                  
  24 :       CALL ADDIMA(MXMA1.XMAT,XMAT,M,M,2)                                        
  25 :       DO 4 I=1,M                                                                
  26 :          MXMA1.XMAT(II,I)=0.D0                                                  
  27 :          MXMA1.XMAT(I,II)=0.D0                                                  
  28 :     4 CONTINUE                                                                  
  29 :       MP=MXMA1                                                                  
  30 :       SEGSUP MLREEL,MLREE1                                                      
  31 :       RETURN                                                                    
  32 :       END                                                                       
  33 :  

© Cast3M 2003 - All rights reserved.
Disclaimer