C OPCHEL    SOURCE    PV        09/03/12    21:29:52     6325           
      SUBROUTINE OPCHEL(IPO1,IEPS,IRET)
C=====================================================================
C     
C     EFFECTUE DIVERSES OPERATIONS SUR DES MCHAML
C  ENTREES
C     IPO1=POINTEUR SUR LE CHAMPS PAR ELEMENT
C     IEPS= 1 COSINUS
C         = 2 SINUS
C         = 3 TANGENTE   L INFINI PAR 0
C         = 4 ARCOSINUS  VIRER LES MODULOS
C         = 5 ARCSINUS   VIRER LES MODULOS
C         = 6 ARCTANGENTE
C         = 7 EXPONENTIELLE
C         = 8 LOGARITHME
C         = 9 VALEUR ABSOLUE
C         =10 COSINUS HYPERBOLIQUE
C         =11 SINUS HYPERBOLIQUE
C         =12 TANGENTE HYPERBOLIQUE
C         =13 ERF FONCTION D'ERRREUR DE GAUSS
C  SORTIES
C     IRET=POINTEUR SUR LE CHAMP RESULTANT
C         =0  SI OPERATION IMPOSSSIBLE
C     
C     PASSAGE AUX NOUVEAUX CHAMELEMS LE 3 09 90 PAR I.MONNIER
C     
C=====================================================================
C     
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C     
-INC SMCHAML
-INC CCOPTIO
-INC CCREEL
C     
      PARAMETER (CEN180=180.D0)
C     
      XCONV=XPI/CEN180
      XVNOC=CEN180/XPI
      IRET=0
      MCHEL1 = IPO1
      SEGINI,MCHELM=MCHEL1
      IRET = MCHELM
      NSOUS = IMACHE(/1)
*     
      DO 72 IA=1,NSOUS
*     
         MCHAM1=ICHAML(IA)
         SEGINI,MCHAML=MCHAM1
         ICHAML(IA)=MCHAML
*     
         DO 75 ICOMP=1,IELVAL(/1)
*     
            MELVA1 = IELVAL(ICOMP)
            SEGINI,MELVAL=MELVA1
            IELVAL(ICOMP) = MELVAL
            SEGACT MELVA1
*     
            IF (TYPCHE(ICOMP).EQ.'REAL*8') GOTO 1666
C     
            GOTO 166
C     
 1666       N1PTEL=VELCHE(/1)
            N1EL  =VELCHE(/2)
            GOTO( 1, 2,66,66,66, 6, 7, 8, 9,10,11,12,13),IEPS
 66         IRET=0
            GOTO 666
 1          CONTINUE
C     
C         COSINUS
C     
            DO 1000 IB=1,N1PTEL
               DO 1001 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
                  XX=XX*XCONV
                  VELCHE(IB,ID)=COS(XX)
 1001          CONTINUE
 1000       CONTINUE
            GOTO 166
C     
C         SINUS
C     
 2          CONTINUE
            DO 20 IB=1,N1PTEL
               DO 21 ID=1,N1EL
                  XX =MELVA1.VELCHE(IB,ID)
                  XX=XX*XCONV
                  VELCHE(IB,ID)=SIN(XX)
 21            CONTINUE
 20         CONTINUE
            GOTO 166
C     
C         TANGENTE
C     
*   3     CONTINUE
*         DO 30 IB=1,N1PTEL
*         DO 31 ID=1,N1EL
*         XX=MELVA1.VELCHE(IB,ID)
*         XX=XX*XCONV
*         VELCHE(IB,ID)=DTAN(XX)
*  31     CONTINUE
*  30     CONTINUE
*         GOTO 166
*C    
*C        ARCOSINUS
*C    
*   4     CONTINUE
*         DO 40 IB=1,N1PTEL
*         DO 41 ID=1,N1EL
*         XX=MELVA1.VELCHE(IB,ID)
*         XX=XVNOC*ACOS(XX)
*         VELCHE(IB,ID)=XX
*  41     CONTINUE
*  40     CONTINUE
*         GOTO 166
*C    
*C        ARCSINUS
*C    
*   5     CONTINUE
*         DO 50 IB=1,N1PTEL
*         DO 51 ID=1,N1EL
*         XX=MELVA1.VELCHE(IB,ID)
*         XX=XVNOC*DASIN(XX)
*         VELCHE(IB,ID)=XX
*  51     CONTINUE
*  50     CONTINUE
*         GOTO 166
C     
C         ARCTANGENTE
C     
 6          CONTINUE
            DO 60 IB=1,N1PTEL
               DO 61 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
                  XX=XVNOC*ATAN(XX)
                  VELCHE(IB,ID)=XX
 61            CONTINUE
 60         CONTINUE
            GOTO 166
C     
C         EXPONENTIELLE
C     
 7          CONTINUE
            DO 70 IB=1,N1PTEL
               DO 71 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
                  XX=EXP(XX)
                  VELCHE(IB,ID)=XX
 71            CONTINUE
 70         CONTINUE
            GOTO 166
C     
C         LOGARITME
C     
 8          CONTINUE
            DO 80 IB=1,N1PTEL
               DO 81 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
*     
                  IF(XX.LT.XPETIT) THEN
                     IRET=0
                     CALL ERREUR(36)
                     SEGSUP MELVAL,MCHELM
                     SEGDES MELVA1,MCHEL1
                     RETURN
                  ENDIF
*     
                  XX=LOG(XX)
                  VELCHE(IB,ID)=XX
 81            CONTINUE
 80         CONTINUE
            GOTO 166
C     
C         VALEUR ABSOLUE
C     
 9          CONTINUE
            DO 90 IB=1,N1PTEL
               DO 91 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
                  XX=ABS(XX)
                  VELCHE(IB,ID)=XX
 91            CONTINUE
 90         CONTINUE
            GOTO 166
C     
C         COSINUS HYPERBOLIQUE
C     
 10         CONTINUE
            DO 100 IB=1,N1PTEL
               DO 101 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
                  XX=COSH(XX)
                  VELCHE(IB,ID)=XX
 101           CONTINUE
 100        CONTINUE
            GOTO 166
C     
C         SINUS HYPERBOLIQUE
C     
 11         CONTINUE
            DO 110 IB=1,N1PTEL
               DO 111 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
                  XX=SINH(XX)
                  VELCHE(IB,ID)=XX
 111           CONTINUE
 110        CONTINUE
            GOTO 166
C     
C         TANGENTE HYPERBOLIQUE
C     
 12         CONTINUE
            DO 120 IB=1,N1PTEL
               DO 121 ID=1,N1EL
                  XX=MELVA1.VELCHE(IB,ID)
                  XX=TANH(XX)
                  VELCHE(IB,ID)=XX
 121           CONTINUE
 120        CONTINUE
            GOTO 166
C     
C         ERF
C     
 13         CONTINUE
            DO 130 IB=1,N1PTEL
               DO 131 ID=1,N1EL
                  XX = MELVA1.VELCHE(IB,ID)
                  YY = ERGAUS(XX)
                  VELCHE(IB,ID)=YY
 131           CONTINUE
 130        CONTINUE
*     
 166        CONTINUE
            SEGDES MELVAL
            SEGDES MELVA1
*     
 75      CONTINUE
         SEGDES MCHAML
*     
 72   CONTINUE
      SEGDES MCHELM
 666  CONTINUE
      RETURN
      END