Download t1c2dp.eso

Back to the list

   1 : C T1C2DP    SOURCE    CHAT      05/01/13    03:29:16     5004           
   2 :       SUBROUTINE T1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP,               
   3 :      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPPLDP,ALPHA,KERRE)                           
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   6 : -INC CCOPTIO                                                                    
   7 :       DIMENSION SIG(3),DSIG(3),SGG(3),DSGG(3),SFG(3),DSFG(3),                   
   8 :      1 A(3),B(3),IDAM(3),EPC(3),SSI(3),SI(3),EPC1(3),SG1(3),                    
   9 :      1 SG2(3),EC1(3),EC2(3),AT(4),BT(2),EPDP(3),EPPLDP(3),TENS(3)               
  10 :       ITER=0                                                                    
  11 :       Y=YOUN/(1.D0-ANU*ANU)                                                     
  12 :       DO 5 ITYP=1,3                                                             
  13 :       EPPLDP(ITYP)=0.D0                                                         
  14 :     5 EPDP(ITYP)=0.D0                                                           
  15 :       XT=0.D0                                                                   
  16 :       IF(IIMPI.EQ.9) WRITE(IOIMP,9999)                                          
  17 : 9999  FORMAT(1X,'T1C2DP TRIPLAGE TRACTION 1 COMP 2 DRUCKER',/)                  
  18 :  9998 FORMAT(1X,'T1C2DP ',I4,'ITERATIONS INTERNES',/)                           
  19 : C                                                                               
  20 : C------------------------------------------------                               
  21 : C     TRIPLAGE TRACTION 1 COMPRESSION 2 DRUCKER                                 
  22 : C------------------------------------------------                               
  23 : C----------------------------------------------                                 
  24 : C     DEFINITION D UNE CONTRAINTE DE REFERENCE                                  
  25 : C     SI RMAX DU DRUCKER INFERIEURE A CETTE VALEUR                              
  26 : C     ALORS SIGMA=0                                                             
  27 : C----------------------------------------------                                 
  28 : C                                                                               
  29 :       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))                                
  30 :       SIREF=1.E-6*YOUN                                                          
  31 : C                                                                               
  32 : C--------------------------------------------------                             
  33 : C     CAS OU LE RAYON DU DRUCKER EST INFERIEUR                                  
  34 : C     A UNE VALEUR DE REFERENCE                                                 
  35 : C--------------------------------------------------                             
  36 : C                                                                               
  37 :       IF(SIREF.GT.RMAX) THEN                                                    
  38 :       DO 10 ITYP=1,3                                                            
  39 :   10  SIG(ITYP)=SIG(ITYP)+DSIG(ITYP)                                            
  40 :       RDP=0.D0                                                                  
  41 :       HDP=0.D0                                                                  
  42 :       ADP=0.D0                                                                  
  42 :       CALL NORME(SIG,DL3)                                                       
  43 :       DL3=DL3/YOUN*10.D0                                                        
  44 :       XLAM3=XLAM3+DL3                                                           
  44 :       CALL CPHOIN(SIG,EPPLDP,YOUN,ANU)                                          
  45 :       DO 20 ITYP=1,3                                                            
  46 :       IDAM(ITYP)=0                                                              
  47 :       DSIG(ITYP)=0.D0                                                           
  48 :   20  SIG(ITYP)=0.D0                                                            
  49 :       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER                                     
  50 :       RETURN                                                                    
  51 :       ENDIF                                                                     
  52 : C-----------------------------------------------                                
  53 : C     ON SE PLACE DANS LE REPERE DE FISSURATION                                 
  54 : C-----------------------------------------------                                
  55 : C                                                                               
  55 :       CALL CHREP(SIG,SFG,ANG)                                                   
  55 :       CALL CHREP(DSIG,DSFG,ANG)                                                 
  56 : C                                                                               
  57 : C-----------------------------------------------------                          
  58 : C     ESTIMATION DU PAS D'INCREMENT DE CONTRAINTES                              
  59 : C-----------------------------------------------------                          
  60 : C                                                                               
  60 :       CALL SIJ(SFG,SI,SIETOI)                                                   
  60 :       CALL EPSDP(SI,SIETOI,ADP,EPC)                                             
  60 :       CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)                                       
  60 :       CALL SCAL2(EPC,SSI,VAL)                                                   
  61 :       VAL=VAL-HDP                                                               
  62 :       IF(VAL.LT.0.D0) THEN                                                      
  63 :       KERRE=459                                                                 
  64 :       RETURN                                                                    
  65 :       ENDIF                                                                     
  65 :       CALL SCAL(SSI,DSFG,VAL)                                                   
  65 :       CALL NORME(DSFG,VA1)                                                      
  65 :       CALL NORME(SSI,VA2)                                                       
  66 :       IF(VA1.EQ.0.D0) THEN                                                      
  67 :       IDAM(1)=0                                                                 
  68 :       IDAM(2)=0                                                                 
  69 :       IDAM(3)=0                                                                 
  70 :       RETURN                                                                    
  71 :       ENDIF                                                                     
  72 :       RMIN=MIN((RDP/1.73),(RDP/(1.D0+2.D0*ADP)))                                
  73 :       X=VAL/VA1/VA2                                                             
  74 :       IF(X.GE.1.D0) THEN                                                        
  75 :       X=1.D0                                                                    
  76 :       GOTO 25                                                                   
  77 :       ENDIF                                                                     
  78 :       X=1.D0/SQRT(1.0001D0-X*X)*RMIN/VA1/8.D0                                   
  79 :       IF(X.GT.1.D0) X=1.D0                                                      
  80 : C                                                                               
  81 : C----------------------------------------------------------                     
  82 : C     ON ECOULE ET ON REGARDE LA VARIATION DE NORMALE                           
  83 : C----------------------------------------------------------                     
  84 : C                                                                               
  85 : C                                                                               
  86 : C---------------------------------------                                        
  87 : C     RESOLUTION DU SYSTEME EN DL3                                              
  88 : C---------------------------------------                                        
  89 :    25 X=X/2.D0                                                                  
  90 :       EC1(1)=1.D0                                                               
  91 :       EC1(2)=0.D0                                                               
  92 :       EC1(3)=0.D0                                                               
  93 :       EC2(1)=0.D0                                                               
  94 :       EC2(2)=1.D0                                                               
  95 :       EC2(3)=0.D0                                                               
  95 :       CALL CPHOOB(EC1,SG1,YOUN,ANU)                                             
  95 :       CALL CPHOOB(EC2,SG2,YOUN,ANU)                                             
  96 :    51 X=X*2.D0                                                                  
  97 :    52 RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))                                
  98 :       ITER=ITER+1                                                               
  99 :   653 IF(ITER.GT.200) THEN                                                      
 100 :       KERRE=460                                                                 
 101 :       RETURN                                                                    
 102 :       ENDIF                                                                     
 103 :       IF(SIREF.GT.RMAX) THEN                                                    
 104 :       RDP=0.D0                                                                  
 105 :       ADP=0.D0                                                                  
 106 :       HDP=0.D0                                                                  
 107 :       DO 60 ITYP=1,3                                                            
 108 :    60 SFG(ITYP)=SFG(ITYP)+(1.D0-XT)*DSFG(ITYP)                                  
 108 :       CALL NORME(SFG,DL3)                                                       
 109 :       DL3=DL3/YOUN*10.D0                                                        
 110 :       XLAM3=XLAM3+DL3                                                           
 110 :       CALL CPHOIN(SFG,EPPLDP,YOUN,ANU)                                          
 111 :       DO 70 ITYP=1,3                                                            
 112 :    70 EPDP(ITYP)=EPDP(ITYP)+EPPLDP(ITYP)                                        
 112 :       CALL CHREP(EPDP,EPPLDP,-ANG)                                              
 113 :       DO 80 ITYP=1,3                                                            
 114 :       IDAM(ITYP)=0                                                              
 115 :       DSIG(ITYP)=0.D0                                                           
 116 :    80 SIG(ITYP)=0.D0                                                            
 117 :       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER                                     
 118 :       RETURN                                                                    
 119 :       ENDIF                                                                     
 120 :       IF((XT+X).GT.1.D0) X=1.D0-XT                                              
 120 :       CALL SIJ(SFG,SI,SIETOI)                                                   
 120 :       CALL EPSDP(SI,SIETOI,ADP,EPC)                                             
 120 :       CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)                                       
 120 :       CALL SCAL2(EPC,SSI,VAL)                                                   
 121 :       VAL=VAL-HDP                                                               
 122 :       IF(VAL.LT.0.D0) THEN                                                      
 123 :       KERRE=459                                                                 
 124 :       RETURN                                                                    
 125 :       ENDIF                                                                     
 126 : C                                                                               
 127 :    90 ITER=ITER+1                                                               
 128 :       IF(ITER.GT.201) GOTO 653                                                  
 129 :       IDAM(2)=-1                                                                
 130 :       AT(1)=Y-H1                                                                
 131 :       AT(4)=Y                                                                   
 132 :       AT(2)=Y*ANU                                                               
 133 :       AT(3)=AT(2)                                                               
 134 :       DO 95 ITYP=1,3                                                            
 135 :    95 DSGG(ITYP)=X*DSFG(ITYP)                                                   
 136 :       BT(1)=SFG(1)+DSGG(1)-RT1                                                  
 137 :       BT(2)=SFG(2)+DSGG(2)                                                      
 137 :       CALL SYLIN2(AT,BT,DL11,DL21)                                              
 138 :       BT(1)=-SSI(1)                                                             
 139 :       BT(2)=-SSI(2)                                                             
 139 :       CALL SYLIN2(AT,BT,DL12,DL22)                                              
 140 :       DO 100 ITYP=1,3                                                           
 141 :       A(ITYP)=SFG(ITYP)+DSGG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)                
 142 :   100 B(ITYP)=-DL12*SG1(ITYP)-DL22*SG2(ITYP)-SSI(ITYP)                          
 142 :       CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST)                                    
 143 :       IF(ITEST.EQ.1) THEN                                                       
 144 :       X=X/2.D0                                                                  
 145 :       GOTO 90                                                                   
 146 :       ENDIF                                                                     
 147 :       DL1=DL11+DL3*DL12                                                         
 148 :       DL2=DL21+DL3*DL22                                                         
 149 :       DO 105 ITYP=1,3                                                           
 150 :       SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP)                           
 151 :   105 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP)                            
 152 :       IF(DL1.LT.-1.D-10) IDAM(1)=0                                              
 153 :       IF(DL2.GT.1.D-10) IDAM(2)=0                                               
 154 :       IF(DL3.LT.-1.D-10) IDAM(3)=0                                              
 155 :       IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0.OR.IDAM(3).EQ.0) THEN                     
 156 :       DL1=0.D0                                                                  
 157 :       DL2=0.D0                                                                  
 158 :       DL3=0.D0                                                                  
 159 :       X=0.D0                                                                    
 160 :       GOTO 2000                                                                 
 161 :       ENDIF                                                                     
 162 : C                                                                               
 163 : C-------------------------------------------------------                        
 164 : C     ON  VERIFIE SI LA NORMALE DU DRUCKER VARIE PEU                            
 165 : C-------------------------------------------------------                        
 166 : C                                                                               
 166 :       CALL SIJ(SGG,SI,SIETOI)                                                   
 166 :       CALL EPSDP(SI,SIETOI,ADP,EPC1)                                            
 166 :       CALL SCAL(EPC,EPC1,VAL)                                                   
 166 :       CALL NORME(EPC,VA1)                                                       
 166 :       CALL NORME(EPC1,VA2)                                                      
 167 :       CO=VAL/VA1/VA2                                                            
 168 :       IF(CO.LT.0.99) THEN                                                       
 169 :       X=X/2.D0                                                                  
 170 :       GOTO 90                                                                   
 171 :       ENDIF                                                                     
 172 :       RD=RDP-DL3*HDP                                                            
 173 :       RMAX=MAX((RD/1.73),(RD/(1.D0-2.D0*ADP)))                                  
 174 :       IF(RMAX.LT.SIREF) THEN                                                    
 175 :       RDP=0.D0                                                                  
 176 :       GOTO 52                                                                   
 177 :       ENDIF                                                                     
 178 : C                                                                               
 179 : C-------------------------------------------------                              
 180 : C     CAS OU LA TRACTION PASSE EN DESSOUS DE 0                                  
 181 : C-------------------------------------------------                              
 182 : C                                                                               
 183 :       IF((RT1-H1*DL1).GE.-1.E-10) GOTO 200                                      
 184 : C                                                                               
 185 :       IF(H1.EQ.0.D0) H1=1.D0                                                    
 186 :       DL1=RT1/H1                                                                
 187 :       AT(1)=-DSFG(1)                                                            
 188 :       AT(3)=-DSFG(2)                                                            
 189 :       AT(4)=Y                                                                   
 190 :       AT(2)=Y*ANU                                                               
 191 :       BT(1)=SFG(1)-DL1*SG1(1)                                                   
 192 :       BT(2)=SFG(2)-DL1*SG1(2)                                                   
 192 :       CALL SYLIN2(AT,BT,X1,DL21)                                                
 193 :       BT(1)=-SSI(1)                                                             
 194 :       BT(2)=-SSI(2)                                                             
 194 :       CALL SYLIN2(AT,BT,X2,DL22)                                                
 195 :       DO 110 ITYP=1,3                                                           
 196 :       A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL1*SG1(ITYP)-DL21*SG2(ITYP)              
 197 :   110 B(ITYP)=X2*DSFG(ITYP)-DL22*SG2(ITYP)-SSI(ITYP)                            
 197 :       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)                               
 198 :       DO 111 ITYP=1,3                                                           
 199 :       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)                                            
 200 :   111 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)                                           
 200 :       CALL SIJ(SGG,SI,SIETOI)                                                   
 200 :       CALL EPSDP(SI,SIETOI,ADP,EPC1)                                            
 200 :       CALL SCAL(EPC,EPC1,VAL)                                                   
 200 :       CALL NORME(EPC,VA1)                                                       
 200 :       CALL NORME(EPC1,VA2)                                                      
 201 :       CO1=VAL/VA1/VA2                                                           
 201 :       CALL SIJ(DSGG,SI,SIETOI)                                                  
 201 :       CALL EPSDP(SI,SIETOI,ADP,EPC1)                                            
 201 :       CALL SCAL(EPC,EPC1,VAL)                                                   
 201 :       CALL NORME(EPC,VA1)                                                       
 201 :       CALL NORME(EPC1,VA2)                                                      
 202 :       CO2=VAL/VA1/VA2                                                           
 203 :       XIN1=X1+X2*DL31                                                           
 204 :       XIN2=X1+X2*DL32                                                           
 205 :       DLIN1=DL21+DL31*DL22                                                      
 206 :       DLIN2=DL21+DL32*DL22                                                      
 207 :       IF(XIN1.GT.-1.E-10.AND.DLIN1.LT.1.E-10.AND.XIN1.LE.X                      
 208 :      1 .AND.CO1.GT.0.9) THEN                                                    
 209 :       DL3=DL31                                                                  
 210 :       X=XIN1                                                                    
 211 :       DL2=DLIN1                                                                 
 212 :       GOTO 200                                                                  
 213 :       ENDIF                                                                     
 214 :       IF(XIN2.GT.-1.E-10.AND.DLIN2.LT.1.E-10.AND.XIN2.LE.X                      
 215 :      1 .AND.CO2.GT.0.9) THEN                                                    
 216 :       DL3=DL32                                                                  
 217 :       X=XIN2                                                                    
 218 :       DL2=DLIN2                                                                 
 219 :       GOTO 200                                                                  
 220 :       ENDIF                                                                     
 221 :       IF(IIMPI.EQ.9) WRITE(IOIMP,10101)                                         
 222 : 10101 FORMAT(1X,'ERREUR DANS T1C2DP TRAC',/)                                    
 223 :       DL3=DL31                                                                  
 224 :       X=XIN1                                                                    
 225 :       DL2=DLIN1                                                                 
 226 :   200 IF((XLAM2+DL2).GE.0.D0) GOTO 300                                          
 227 : C                                                                               
 228 : C-------------------------------------------------                              
 229 : C     CAS OU LA FISSURE 2 EST TOTALEMENT FERME                                  
 230 : C-------------------------------------------------                              
 231 : C                                                                               
 232 : C                                                                               
 233 :       IDAM(2)=0                                                                 
 234 :       DL2=-XLAM2                                                                
 235 :       AT(1)=-DSFG(1)                                                            
 236 :       AT(3)=-DSFG(2)                                                            
 237 :       AT(2)=Y-H1                                                                
 238 :       AT(4)=Y*ANU                                                               
 239 :       BT(1)=SFG(1)-DL2*SG2(1)-RT1                                               
 240 :       BT(2)=SFG(2)-DL2*SG2(2)                                                   
 240 :       CALL SYLIN2(AT,BT,X1,DL11)                                                
 241 :       BT(1)=-SSI(1)                                                             
 242 :       BT(2)=-SSI(2)                                                             
 242 :       CALL SYLIN2(AT,BT,X2,DL12)                                                
 243 :       DO 210 ITYP=1,3                                                           
 244 :       A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL11*SG1(ITYP)-DL2*SG2(ITYP)              
 245 :   210 B(ITYP)=X2*DSFG(ITYP)-DL12*SG1(ITYP)-SSI(ITYP)                            
 245 :       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)                               
 246 :       DO 211 ITYP=1,3                                                           
 247 :       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)                                            
 248 :   211 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)                                           
 248 :       CALL SIJ(SGG,SI,SIETOI)                                                   
 248 :       CALL EPSDP(SI,SIETOI,ADP,EPC1)                                            
 248 :       CALL SCAL(EPC,EPC1,VAL)                                                   
 248 :       CALL NORME(EPC,VA1)                                                       
 248 :       CALL NORME(EPC1,VA2)                                                      
 249 :       CO1=VAL/VA1/VA2                                                           
 249 :       CALL SIJ(DSGG,SI,SIETOI)                                                  
 249 :       CALL EPSDP(SI,SIETOI,ADP,EPC1)                                            
 249 :       CALL SCAL(EPC,EPC1,VAL)                                                   
 249 :       CALL NORME(EPC,VA1)                                                       
 249 :       CALL NORME(EPC1,VA2)                                                      
 250 :       CO2=VAL/VA1/VA2                                                           
 251 :       XIN1=X1+X2*DL31                                                           
 252 :       XIN2=X1+X2*DL32                                                           
 253 :       DLIN1=DL11+DL31*DL12                                                      
 254 :       DLIN2=DL11+DL32*DL12                                                      
 255 :       IF(XIN1.GT.-1.E-10.AND.DLIN1.GT.-1.E-10.AND.XIN1.LE.X                     
 256 :      1 .AND.CO1.GT.0.9) THEN                                                    
 257 :       DL3=DL31                                                                  
 258 :       X=XIN1                                                                    
 259 :       DL1=DLIN1                                                                 
 260 :       GOTO 300                                                                  
 261 :       ENDIF                                                                     
 262 :       IF(XIN2.GT.-1.E-10.AND.DLIN2.GT.-1.E-10.AND.XIN2.LE.X                     
 263 :      1 .AND.CO2.GT.0.9) THEN                                                    
 264 :       DL3=DL32                                                                  
 265 :       X=XIN2                                                                    
 266 :       DL1=DLIN2                                                                 
 267 :       GOTO 300                                                                  
 268 :       ENDIF                                                                     
 269 :       IF(IIMPI.EQ.9) WRITE(IOIMP,20202)                                         
 270 : 20202 FORMAT(1X,'ERREUR DANS T1C2DP FERM',/)                                    
 271 :       DL3=DL31                                                                  
 272 :       X=XIN1                                                                    
 273 :       DL1=DLIN1                                                                 
 274 :   300 DO 310 ITYP=1,3                                                           
 275 :       SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP)                           
 276 :   310 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP)                            
 277 :       RDP=RDP-DL3*HDP                                                           
 278 :       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))                                
 279 :       IF(RMAX.LT.SIREF) THEN                                                    
 280 :       RDP=0.D0                                                                  
 281 :       GOTO 52                                                                   
 282 :       ENDIF                                                                     
 283 :       XT=XT+X                                                                   
 284 :       DO 330 ITYP=1,3                                                           
 285 :       EPDP(ITYP)=EPDP(ITYP)+DL3*EPC(ITYP)                                       
 286 :   330 SFG(ITYP)=SGG(ITYP)                                                       
 287 :       XLAM1=XLAM1+DL1                                                           
 288 :       XLAM2=XLAM2+DL2                                                           
 289 :       XLAM3=XLAM3+DL3                                                           
 290 :       RT1=RT1-H1*DL1                                                            
 291 :       IF(RT1.LT.1.E-10) THEN                                                    
 292 :       H1=0.D0                                                                   
 293 :       RT1=0.D0                                                                  
 294 :       ENDIF                                                                     
 295 :       IF(XLAM2.LT.1.E-10) THEN                                                  
 296 :       IDAM(2)=0                                                                 
 297 :       XLAM2=0.D0                                                                
 298 :       ENDIF                                                                     
 299 :       IF(IDAM(2).EQ.0) THEN                                                     
 300 :       XLAM2=0.D0                                                                
 301 : C                                                                               
 302 :       DO 340 ITYP=1,3                                                           
 303 :       DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)                                           
 304 :   340 TENS(ITYP)=SFG(ITYP)+DSFG(ITYP)                                           
 305 :       GAMTR1=10.D0                                                              
 306 :       GAMTR2=10.D0                                                              
 307 :       GAMCO1=10.D0                                                              
 308 : C                                                                               
 309 :       GAMDP=10.D0                                                               
 309 :       CALL CTRAF(TENS(1),RT1,VCTR1)                                             
 309 :       CALL CTRAF(TENS(2),RT2,VCTR2)                                             
 309 :       CALL CCOAF(TENS(1),XLAM1,VCCO1)                                           
 310 : C                                                                               
 310 :       CALL CDP(TENS,ADP,RDP,VCDP)                                               
 310 :       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1)                  
 310 :       IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2)                  
 310 :       IF(VCCO1.GT.0.D0) CALL GAMCAF(SFG(1),DSFG(1),GAMCO1)                      
 311 : C                                                                               
 311 :       IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP)                         
 312 :       IDAM(1)=0                                                                 
 313 :       IDAM(2)=0                                                                 
 314 :       IDAM(3)=0                                                                 
 315 :       GAM=MIN(GAMTR1,GAMTR2,GAMCO1,GAMDP)                                       
 316 :       IF(GAM.GE.1.D0) THEN                                                      
 317 :       DO 341 ITYP=1,3                                                           
 318 :       SFG(ITYP)=SFG(ITYP)+DSFG(ITYP)                                            
 319 :  341  DSIG(ITYP)=0.D0                                                           
 319 :       CALL CHREP(SFG,SIG,-ANG)                                                  
 319 :       CALL CHREP(EPDP,EPPLDP,-ANG)                                              
 320 :       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER                                     
 321 :       RETURN                                                                    
 322 :       ENDIF                                                                     
 323 :       IF(ABS(GAM-GAMTR1).LE.1.E-10) IDAM(1)=1                                   
 324 :       IF(ABS(GAM-GAMCO1).LE.1.E-10) IDAM(1)=-1                                  
 325 :       IF(ABS(GAM-GAMTR2).LE.1.E-10) IDAM(2)=1                                   
 326 : C                                                                               
 327 :       IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1                                    
 328 :       DO 342 ITYP=1,3                                                           
 329 :       SFG(ITYP)=SFG(ITYP)-GAM*DSFG(ITYP)                                        
 330 :  342  DSFG(ITYP)=(1.D0-GAM)*DSFG(ITYP)                                          
 330 :       CALL CHREP(SFG,SIG,-ANG)                                                  
 330 :       CALL CHREP(DSFG,DSIG,-ANG)                                                
 330 :       CALL CHREP(EPDP,EPPLDP,-ANG)                                              
 331 :       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER                                     
 332 :       RETURN                                                                    
 333 :       ENDIF                                                                     
 334 :       C=1.D0-1.D-10                                                             
 335 :       IF(XT.GE.C) THEN                                                          
 336 :       DO 350 ITYP=1,3                                                           
 337 :       IDAM(ITYP)=0                                                              
 338 :   350 DSIG(ITYP)=0.D0                                                           
 338 :       CALL CHREP(SFG,SIG,-ANG)                                                  
 338 :       CALL CHREP(EPDP,EPPLDP,-ANG)                                              
 339 :       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER                                     
 340 :       RETURN                                                                    
 341 :       ENDIF                                                                     
 342 :       GOTO 51                                                                   
 343 :  2000 CONTINUE                                                                  
 343 :       CALL CHREP(SFG,SIG,-ANG)                                                  
 344 :       DO 2010 ITYP=1,3                                                          
 345 :  2010 DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)                                           
 345 :       CALL CHREP(DSFG,DSIG,-ANG)                                                
 345 :       CALL CHREP(EPDP,EPPLDP,-ANG)                                              
 346 :       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER                                     
 347 :       RETURN                                                                    
 348 :       END                                                                       
 349 :  

© Cast3M 2003 - All rights reserved.
Disclaimer