Download dyne00.eso

Back to the list

   1 : C DYNE00    SOURCE    CHAT      09/10/09    21:17:27     6519           
   2 :       SUBROUTINE DYNE00(IPRIGM,IRSCPR,ICHOLX,LONVEC)                            
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 : ************************************************************************        
   6 : *                                                                               
   7 : *                             D Y N E 0 0                                       
   8 : *                             -----------                                       
   9 : *                                                                               
  10 : * FONCTION:                                                                     
  11 : * ---------                                                                     
  12 : *     UTILITAIRE DE L'OPERATEUR "DYNE"                                          
  13 : *     ASSEMBLAGE EVENTUEL DE LA MATRICE MASSE ET CREATION DE ICPR               
  14 : *                                                                               
  15 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
  16 : * -----------                                                                   
  17 : *                                                                               
  18 : *     IPRIGM  (E)  POINTEUR SUR L'OBJET RIGIDITE M ( LAISSE ACTIF )             
  19 : *     IRSCPR  (S)  POINTEUR SUR LE SEGMENT ICPR ( LAISSE ACTIF )                
  20 : *     ICHOLX  (S)  POINTEUR SUR LE SEGMENT MMATRI ( LAISSE ACTIF )              
  21 : *     LONVEC  (S)  NOMBRE DE NOEUDS                                             
  22 : *                                                                               
  23 : * AUTEUR, DATE DE CREATION:                                                     
  24 : * -------------------------                                                     
  25 : *     DENIS ROBERT, LE 16 NOVEMBRE 1988.                                        
  26 : *                                                                               
  27 : * LANGAGE:                                                                      
  28 : * --------                                                                      
  29 : *     ESOPE + FORTRAN77                                                         
  30 : *                                                                               
  31 : ************************************************************************        
  32 : *                                                                               
  33 : * MODULES UTILISES:                                                             
  34 : *                                                                               
  35 : -INC CCOPTIO                                                                    
  36 : -INC SMRIGID                                                                    
  37 : -INC SMELEME                                                                    
  38 : -INC SMMATRI                                                                    
  39 : -INC SMCOORD                                                                    
  40 : *                                                                               
  41 :       SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
  42 : *                                                                               
  43 :       MRIGID=IPRIGM                                                             
  44 :       SEGACT,MRIGID                                                             
  45 :       IF (ICHOLE.EQ.0) THEN                                                     
  46 : *                                                                               
  47 : *---     ASSEMBLAGE DE M                                                        
  48 : *                                                                               
  48 :          CALL ASSEM1(IPRIGM,MMATRX,INUINX,ITOPOX,IMINIX,IPOX,INCTRX             
  49 :      *   ,LL)                                                                   
  49 :          CALL ASSEM2(IPRIGM,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX             
  50 :      *   ,LL)                                                                   
  51 :          IF(IERR.NE.0) RETURN                                                   
  52 :          MRIGID=IPRIGM                                                          
  53 :          SEGACT,MRIGID                                                          
  54 :          ICHOLE=MMATRX                                                          
  55 :       ENDIF                                                                     
  56 :       ICHOLX=ICHOLE                                                             
  57 : *                                                                               
  58 :       MMATRI=ICHOLX                                                             
  59 :       SEGACT,MMATRI                                                             
  60 :       MELEME=IGEOMA                                                             
  61 : *                                                                               
  62 : *---  FABRICATION DE ICPR                                                       
  63 : *                                                                               
  64 :       SEGACT,MCOORD                                                             
  65 :       SEGINI,ICPR                                                               
  66 :       LX=ICPR(/1)                                                               
  67 :       DO 2 I=1,LX                                                               
  68 :          ICPR(I)=0                                                              
  69 :  2       CONTINUE                                                               
  70 : *     END DO                                                                    
  71 :       SEGACT,MELEME                                                             
  72 :       N1=NUM(/1)                                                                
  73 :       N2=NUM(/2)                                                                
  74 :       IK=0                                                                      
  75 :       DO 3 I1=1,N1                                                              
  76 :       DO 3 I2=1,N2                                                              
  77 :          K=NUM(I1,I2)                                                           
  78 :          IF(ICPR(K).NE.0) GOTO 3                                                
  79 :          IK=IK+1                                                                
  80 :          ICPR(K)=IK                                                             
  81 :  3       CONTINUE                                                               
  82 : *     END DO                                                                    
  83 : *                                                                               
  84 :       MILIGN=IILIGN                                                             
  85 :       SEGACT,MILIGN                                                             
  86 :       LONVEC=IPNO(/1)                                                           
  87 :       SEGDES,MILIGN                                                             
  88 : *                                                                               
  89 :       IRSCPR=ICPR                                                               
  90 : *                                                                               
  91 :       END                                                                       
  92 :  
  93 :  
  94 :  
  95 :  
  96 :  
  97 :  
  98 :  
  99 :  
 100 :  

© Cast3M 2003 - All rights reserved.
Disclaimer