Download absolu.eso

Back to the list

   1 : C ABSOLU    SOURCE    CHAT      12/08/09    21:15:01     7484           
   2 : C   VALEUR ABSOLUE                                                              
   3 : C                                                                               
   4 :       SUBROUTINE ABSOLU                                                         
   5 : 
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8(A-H,O-Z)
   8 : 
   9 : -INC CCOPTIO                                                                    
  10 : C                                                                               
  11 : C     CHPOINT                                                                   
  12 : C                                                                               
  12 :       CALL LIROBJ('CHPOINT ',IPO1,0,IRETOU)                                     
  13 :       IF (IRETOU.EQ.0) GOTO 10                                                  
  13 :       CALL OPCHPO(IPO1,9,IPO2)                                                  
  13 :       CALL ECROBJ('CHPOINT ',IPO2)                                              
  14 :       RETURN                                                                    
  15 : C                                                                               
  16 : C     MCHAML                                                                    
  17 : C                                                                               
  18 :   10  CONTINUE                                                                  
  18 :       CALL LIROBJ('MCHAML',IPO1,0,IRETOU)                                       
  19 :       IF (IRETOU.EQ.0) GOTO 20                                                  
  19 :       CALL OPCHEL(IPO1,9,IPO2)                                                  
  19 :       CALL ECROBJ('MCHAML',IPO2)                                                
  20 :       RETURN                                                                    
  21 : C                                                                               
  22 : C     LISTREEL                                                                  
  23 : C                                                                               
  24 :   20  CONTINUE                                                                  
  24 :       CALL LIROBJ('LISTREEL',IPO1,0,IRETOU)                                     
  25 :       IF (IRETOU.EQ.0) GOTO 30                                                  
  25 :       CALL OPLREE(IPO1,9,IPO2)                                                  
  25 :       CALL ECROBJ('LISTREEL',IPO2)                                              
  26 :       RETURN                                                                    
  27 : C                                                                               
  28 : C     ENTIER                                                                    
  29 : C                                                                               
  30 :   30  CONTINUE                                                                  
  30 :       CALL LIRENT(IR,0,IRETOU)                                                  
  31 :       IF (IRETOU.EQ.0) GOTO 40                                                  
  31 :       CALL ECRENT(ABS(IR))                                                      
  32 :       RETURN                                                                    
  33 : C                                                                               
  34 : C     FLOTTANT                                                                  
  35 : C                                                                               
  36 :   40  CONTINUE                                                                  
  36 :       CALL LIRREE(XR,0,IRETOU)                                                  
  37 :       IF (IRETOU.EQ.0) GO TO 50                                                 
  37 :       CALL ECRREE(ABS(XR))                                                      
  38 :       RETURN                                                                    
  39 : C                                                                               
  40 : C     EVOLUTION                                                                  
  41 : C                                                                               
  42 :   50  CONTINUE                                                                  
  42 :       CALL LIROBJ('EVOLUTIO',IPO1,0,IRETOU)                                     
  43 :       IF (IRETOU.EQ.0) GO TO 60                                                 
  43 :       CALL OPEVOL(IPO1,9,IPO2)                                                  
  43 :       CALL ECROBJ('EVOLUTIO',IPO2)                                              
  44 :       RETURN                                                                    
  45 : C                                                                               
  46 : C    PAS D OPERANDE CORRECTE TROUVE                                             
  47 : C                                                                               
  47 :  60   CALL QUETYP(MOTERR(1:8),0,IRETOU)                                         
  48 :       IF(IRETOU.NE.0) THEN                                                      
  48 :          CALL ERREUR (39)                                                       
  49 :       ELSE                                                                      
  49 :          CALL ERREUR(533)                                                       
  50 :       ENDIF                                                                     
  51 :       RETURN                                                                    
  52 :       END                                                                       
  53 : 
  54 :  
  55 :  
  56 :  
  57 :  

© Cast3M 2003 - All rights reserved.
Disclaimer