Download carsym.eso

Back to the list

   1 : C CARSYM    SOURCE    CHAT      05/01/12    21:49:26     5004           
   2 :       SUBROUTINE CARSYM (ITYPE,EDICON)                                          
   3 : C                                                                               
   4 : C     SET UP SYMMETRY CONDITIONS FOR THE CARTESIAN (X,Y) COORDINATES            
   5 : C-----------------------------------------------------------------------        
   6 : C                                                                               
   7 : C     PROBLEM CONSTANTS                                                         
   8 :       IMPLICIT INTEGER(I-N)
   9 :       IMPLICIT REAL*8(A-H,O-Z)
  10 : -INC CCREEL                                                  
  11 : C                                                                               
  12 : C                                                                               
  13 : C     CONSTANTS DESCRIBING SYMMETRY CONDITIONS                                  
  14 : C                                                                               
  15 :       segment EDICON                                                            
  16 :         integer  KSTRT, KSTEP, NMIR, is                                         
  17 :         real*8  crot, srot,  symfct                                             
  18 :         LOGICAL LREAL, LIMAG                                                    
  19 :       endsegment                                                                
  20 : C-----------------------------------------------------------------------        
  21 : C                                                                               
  22 :       IF(ITYPE .GE. 10) GO TO 100                                               
  23 :       IF(ITYPE .LE. 0) GO TO 10                                                 
  24 : C                                                                               
  25 : C     "ITYPE" LESS THAN 10 --- PREDEFINED SYMMETRY CODE                         
  26 : C                                                                               
  27 :       GO TO (10, 20, 30, 40, 50, 60, 70, 80, 90), ITYPE                         
  28 : C                                                                               
  29 :    10 KSTRT = 1                                                                 
  30 :       KSTEP = 1                                                                 
  31 :       LREAL = .TRUE.                                                            
  32 :       LIMAG = .TRUE.                                                            
  33 :       GO TO 200                                                                 
  34 : C                                                                               
  35 :    20 KSTRT = 1                                                                 
  36 :       KSTEP = 1                                                                 
  37 :       LREAL = .TRUE.                                                            
  38 :       LIMAG = .FALSE.                                                           
  39 :       GO TO 200                                                                 
  40 : C                                                                               
  41 :    30 KSTRT = 2                                                                 
  42 :       KSTEP = 2                                                                 
  43 :       LREAL = .TRUE.                                                            
  44 :       LIMAG = .FALSE.                                                           
  45 :       GO TO 200                                                                 
  46 : C                                                                               
  47 :    40 KSTRT = 2                                                                 
  48 :       KSTEP = 4                                                                 
  49 :       LREAL = .TRUE.                                                            
  50 :       LIMAG = .FALSE.                                                           
  51 :       GO TO 200                                                                 
  52 : C                                                                               
  53 :    50 KSTRT = 2                                                                 
  54 :       KSTEP = 4                                                                 
  55 :       LREAL = .FALSE.                                                           
  56 :       LIMAG = .TRUE.                                                            
  57 :       GO TO 200                                                                 
  58 : C                                                                               
  59 :    60 KSTRT = 1                                                                 
  60 :       KSTEP = 2                                                                 
  61 :       LREAL = .TRUE.                                                            
  62 :       LIMAG = .FALSE.                                                           
  63 :       GO TO 200                                                                 
  64 : C                                                                               
  65 :    70 KSTRT = 3                                                                 
  66 :       KSTEP = 6                                                                 
  67 :       LREAL = .TRUE.                                                            
  68 :       LIMAG = .FALSE.                                                           
  69 :       GO TO 200                                                                 
  70 : C                                                                               
  71 :    80 KSTRT = 2                                                                 
  72 :       KSTEP = 2                                                                 
  73 :       LREAL = .TRUE.                                                            
  74 :       LIMAG = .FALSE.                                                           
  75 :       GO TO 200                                                                 
  76 : C                                                                               
  77 :    90 KSTRT = 4                                                                 
  78 :       KSTEP = 8                                                                 
  79 :       LREAL = .TRUE.                                                            
  80 :       LIMAG = .FALSE.                                                           
  81 :       GO TO 200                                                                 
  82 : C                                                                               
  83 : C     "ITYPE" MUST BE DECODED                                                   
  84 : C                                                                               
  85 :   100 KSTRT = ITYPE / 100                                                       
  86 :       KSTEP = (ITYPE - 100 * KSTRT) / 10                                        
  87 :       MEDIAN = ITYPE - 100 * KSTRT - 10 * KSTEP                                 
  88 :       LREAL = MEDIAN .GT. 0                                                     
  89 :       LIMAG = MEDIAN .NE. 1                                                     
  90 : C                                                                               
  91 : C     COEFFICIENTS FOR ROTATIONAL SYMMETRY                                      
  92 : C                                                                               
  93 :   200 PHI = 2. * XPI / FLOAT(KSTEP)
  94 :       CROT = COS(PHI)                                                           
  95 :       SROT = SIN(PHI)                                                           
  96 :       NMIR = 2                                                                  
  97 :       IF(LREAL .AND. LIMAG) NMIR = 1                                            
  98 :       SYMFCT = 1.0                                                              
  99 :       IF(KSTEP .GT. KSTRT) SYMFCT = - 1.0                                       
 100 :       RETURN                                                                    
 101 :       END                                                                       
 102 :  
 103 :  
 104 :  

© Cast3M 2003 - All rights reserved.
Disclaimer