Download ccotr2.eso

Back to the list

   1 : C CCOTR2    SOURCE    PV        11/03/07    21:15:25     6885           
   2 : C COTRA2    SOURCE    DELH      91/01/16    21:33:38     207                    
   3 :       SUBROUTINE CCOTR2(WRK52,WRK53,WRK2,NCOURB)                                 
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   6 : -INC SMEVOLL                                                                    
   7 : -INC SMLREEL  
   8 : -INC DECHE                                                                  
   9 :       SEGMENT/WRK2/(TRAC(LTRAC)*D)                                              
  10 : *                                                                               
  11 : *     QUELQUES INITIALISATIONS A 0                                              
  12 : *                                                                               
  13 :       KERRE=0                                                                   
  14 :       NCOURB=0                                                                  
  15 :       LTRAC=TRAC(/1)                                                            
  15 :       CALL ZDANUL(TRAC,LTRAC)                                                   
  16 : *                                                                               
  17 : *     LOIS MOMENT-COURBURE ...                                                  
  18 : *                                                                               
  19 :       MEVOLL=nint(XMAT(5))
  20 :       IF(MEVOLL.EQ.0) THEN                                                      
  21 :         KERRE=37                                                                
  22 :         RETURN                                                                  
  23 :       ENDIF                                                                     
  24 :       SEGACT MEVOLL                                                             
  25 :       JOJO = IEVOLL(/1)                                                         
  26 :       IF(JOJO.NE.1.AND.JOJO.NE.2) THEN                                          
  27 :         KERRE=31                                                                
  28 :         SEGDES MEVOLL                                                     
  29 :         RETURN                                                                  
  30 :       ENDIF                                                                     
  31 : *                                                                               
  32 : *     PREMIERE COURBE  ( SELON Y )                                              
  33 : *                                                                               
  34 :       DO 5 IJOJO=1,2                                                            
  35 :       IF(JOJO.EQ.1) KEVOLL=IEVOLL(1)                                            
  36 :       IF(JOJO.EQ.2) KEVOLL=IEVOLL(IJOJO)                                        
  37 :       SEGACT KEVOLL                                                             
  38 :       MLREEL=IPROGX                                                             
  39 :       MLREE1=IPROGY                                                             
  40 :       SEGDES KEVOLL                                                             
  41 :       SEGACT MLREEL,MLREE1                                                      
  42 :       NBPOIX=PROG(/1)                                                           
  43 :       NBPOIY=MLREE1.PROG(/1)                                                    
  44 :       IF(NBPOIX.NE.NBPOIY) KERRE=31                                             
  45 :       IF(NBPOIX.GT.9) KERRE=31                                                  
  46 :       IF(NBPOIX.LT.5) KERRE=32                                                  
  47 :       IF(KERRE.EQ.0) GO TO 693                                                  
  48 :  692  CONTINUE                                                                  
  49 : *                                                                               
  50 : *   ERREUR                                                                      
  51 : *                                                                               
  52 :       SEGDES MLREEL,MLREE1                                                      
  53 :       SEGDES MEVOLL                                                       
  54 :       GO TO 777                                                                 
  55 :  693  CONTINUE                                                                  
  56 : *                                                                               
  57 :       DO 10 I=1,NBPOIX                                                          
  58 :       PEPS=PROG(I)                                                              
  59 :       PSIG=MLREE1.PROG(I)                                                       
  60 :       NCOURB=NCOURB+1                                                           
  61 :       TRAC(2*NCOURB-1)=PSIG                                                     
  62 :       TRAC(2*NCOURB)  =PEPS                                                     
  63 :   10  CONTINUE                                                                  
  64 : C                                                                               
  65 :       SEGDES MLREEL,MLREE1                                                      
  66 :    5  CONTINUE                                                                  
  67 :       SEGDES MEVOLL                                                       
  68 :       RETURN                                                                    
  69 : C                                                                               
  70 :   777 CONTINUE                                                                  
  71 :       RETURN                                                                    
  72 :       END                                                                       
  73 :  
  74 :  
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  

© Cast3M 2003 - All rights reserved.
Disclaimer