Esope source files

   1 : C OPERHY    SOURCE    BP208322  12/07/10    21:15:22     7432           
   2 :       SUBROUTINE OPERHY(ICAS)
   3 : C
   4 : C     CALCUL DE COSH (ICAS=1),SINH (ICAS=2),TANH (ICAS=3)
   5 : C
   6 :       IMPLICIT INTEGER(I-N)
   7 : -INC CCOPTIO                                                                    
   8 :       REAL*8 X1,X2
   9 :       JCAS = ICAS + 9
  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,JCAS,IPO2)
  13 :       CALL ECROBJ('CHPOINT ',IPO2)                                              
  14 :       RETURN                                                                    
  15 : C                                                                               
  16 : C     CHAMELEM                                                                  
  17 : C                                                                               
  18 :   10  CONTINUE                                                                  
  18 :       CALL LIROBJ('MCHAML',IPO1,0,IRETOU)                                       
  19 :       IF (IRETOU.EQ.0) GO TO 20
  19 :         CALL OPCHEL(IPO1,JCAS,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,JCAS,IPO2)
  25 :       CALL ECROBJ('LISTREEL',IPO2)                                              
  26 :       RETURN                                                                    
  27 : C                                                                               
  28 :   30  CONTINUE                                                                  
  29 : C                                                                               
  30 : C     FLOTTANT                                                                  
  31 : C                                                                               
  31 :       CALL LIRREE(X1,0,IRETOU)                                                  
  32 :       IF (IRETOU.EQ.0) GO TO 40                                                 
  33 :       IF(ICAS.EQ.1) X2 = COSH(X1)
  34 :       IF(ICAS.EQ.2) X2 = SINH(X1)
  35 :       IF(ICAS.EQ.3) X2 = TANH(X1)
  35 :       CALL ECRREE(X2)
  36 :       RETURN                                                                    
  37 : C                                                                               
  38 : C     EVOLUTION                                                                  
  39 : C                                                                               
  40 :   40  CONTINUE                                                                  
  40 :       CALL LIROBJ('EVOLUTIO',IPO1,0,IRETOU)                                     
  41 :       IF (IRETOU.EQ.0) GO TO 50                                                 
  41 :       CALL OPEVOL(IPO1,JCAS,IPO2)                                                  
  41 :       CALL ECROBJ('EVOLUTIO',IPO2)                                              
  42 :       RETURN                                                                    
  43 : C                                                                               
  44 : C     
  45 : C    PAS D OPERANDE CORRECTE TROUVE
  46 : C     
  46 :  50   CALL QUETYP(MOTERR(1:8),0,IRETOU)
  47 :       IF(IRETOU.NE.0) THEN                                                      
  47 :          CALL ERREUR (39)                                                       
  48 :       ELSE                                                                      
  48 :          CALL ERREUR(533)                                                       
  49 :       ENDIF                                                                     
  50 :       RETURN                                                                    
  51 :       END                                                                       
  52 :  
  53 :