C ARCCS     SOURCE    PV        09/03/12    21:15:27     6325           
C ARCCS
      SUBROUTINE ARCCS(IOPT)
*=============================================================
*
*  ARC-COSINUS (si IOPT=1)
*  ARC-SINUS   (si IOPT=2)
*
*=============================================================
*
*  Création      : Maugis 24/09/2007
*  Modifications : Gounand 18/12/2007
*                  Petit rattrapage si argument proche de 1 
*
*=============================================================
*
*  REMARQUES:
*
*=============================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC CCREEL
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
-INC SMLREEL
-INC SMCOORD
-INC TMTRAV
-INC SMCHAML
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
      REAL*8 Y
      CHARACTER*8 ITYP
*     Option de calcul
      IF (IOPT.NE.1 .AND. IOPT.NE.2) THEN
*        Erreur anormale.contactez votre support
         CALL ERREUR(5)
      ENDIF 

*     Un objet de type CHPOINT, LISTREEL, ENTIER ou FLOTTANT est attendu.
      CALL MESLIR(-134)
*    Un nombre un peu plus grand que 1.D0
      XUNP = 1.D0 + (XZPREC ** 0.5D0)
      XUN  = 1.D0
*     Facteur de conversion radian -> degrés
      XRADEG = 180.D0/XPI
*
*     CAS DES CHPOINTS
*
      CALL LIROBJ ('CHPOINT',MCHPO1,0,IRETOU)
      IF(IRETOU.NE.0) THEN
         SEGINI,MCHPOI=MCHPO1
         NS=IPCHP(/1)
         DO I = 1,NS
            MSOUP1 = IPCHP(I)
            SEGINI,MSOUPO=MSOUP1
            IPCHP(I)= MSOUPO
            IPT1    = IGEOC
            SEGINI,IPT2=IPT1
            SEGDES IPT2
            IGEOC   = IPT2
            MPOVA1  = IPOVAL
            SEGINI,MPOVAL=MPOVA1
            IPOVAL  = MPOVAL
            DO K=1,VPOCHA(/2)
               DO J=1,VPOCHA(/1)
                  Y = VPOCHA(J,K)
                  IF (ABS(Y).GT.XUN) THEN
                     IF (ABS(Y).GT.XUNP) THEN
                        SEGDES MPOVAL,MSOUPO,MCHPOI
                        GOTO 999
                     ELSE
                        Y=SIGN(XUN,Y)
                     ENDIF
                  ENDIF 
                  IF (IOPT.EQ.1) THEN
                     VPOCHA(J,K) = ACOS(Y)*XRADEG
                  ELSE
                     VPOCHA(J,K) = ASIN(Y)*XRADEG
                  ENDIF 
               ENDDO
            ENDDO
            SEGDES MPOVAL,MSOUPO
         ENDDO
         SEGDES MCHPOI
         CALL ECROBJ('CHPOINT',MCHPOI)
         RETURN
      ENDIF
*
*     CAS D'UN CHAMP PAR ELEMENT
*
      CALL LIROBJ('MCHAML',MCHEL2,0,IRETOU)
      IF (IERR.NE.0) RETURN
      IF (IRETOU.NE.0) THEN
         SEGINI,MCHELM = MCHEL2
         N1 = ICHAML(/1)
         DO I = 1,N1
            MCHAM1 = ICHAML(I)
            SEGINI,MCHAML = MCHAM1
            ICHAML(I) = MCHAML
            N2 = IELVAL(/1)

*           Vérification que les composantes sont réelles
            DO J = 1,N2
               IF (TYPCHE(J).NE.'REAL*8') THEN
*                 Le type %m1:16 de la composante %m17:20 du champ par
*                 élement %m21:36 ne correspond pas à celui attendu
                  MOTERR(1:8)   = TYPCHE(J)
                  MOTERR(17:20) = NOMCHE(J)
                  MOTERR(21:29) = 'argument'
                  CALL ERREUR(552)
                  DO K = 1,I
                     MCHAML = ICHAML(K)
                     SEGSUP MCHAML
                  ENDDO
                  SEGSUP MCHELM
                  RETURN
               ENDIF
            ENDDO

            DO J = 1,N2
               MELVA1 = IELVAL(J)
               SEGINI,MELVAL=MELVA1
               IELVAL(J) = MELVAL
               N1PTEL = VELCHE(/1)
               N1EL   = VELCHE(/2)
               DO K = 1,N1EL
                  DO L = 1,N1PTEL
                     Y = VELCHE(L,K)
                     IF (ABS(Y).GT.XUN) THEN
                        IF (ABS(Y).GT.XUNP) THEN
                           SEGDES,MELVAL,MCHAM1,MCHAML
                           GOTO 999
                        ELSE
                           Y=SIGN(XUN,Y)
                        ENDIF
                     ENDIF 
                     IF (IOPT.EQ.1) THEN
                        VELCHE(L,K) = ACOS(Y) * XRADEG
                     ELSE
                        VELCHE(L,K) = ASIN(Y) * XRADEG
                     ENDIF 
                  ENDDO
               ENDDO
               SEGDES,MELVAL
            ENDDO
            SEGDES,MCHAM1
            SEGDES,MCHAML
         ENDDO
         SEGDES MCHELM
         CALL ECROBJ('MCHAML' ,MCHELM)
         RETURN
      ENDIF

*
*     CAS DES LISTREELS
*
      IRET1=0
      CALL LIROBJ('LISTREEL',IPREE1,0,IRET1)
      IF (IERR.NE.0) RETURN
      IF (IRET1.EQ.1) THEN
         MLREE1=IPREE1
         SEGACT,MLREE1
         LREE1=MLREE1.PROG(/1)
         JG=LREE1
         SEGINI,MLREEL
         IPREEL=MLREEL
         DO IREE=1,JG
            Y=MLREE1.PROG(IREE)
            IF (ABS(Y).GT.XUN) THEN 
               IF (ABS(Y).GT.XUNP) THEN 
                  SEGDES,MLREEL,MLREE1
                  GOTO 999
               ELSE
                  Y=SIGN(XUN,Y)
               ENDIF
            ENDIF 
            IF (IOPT.EQ.1) THEN
               PROG(IREE)=ACOS(Y)*XRADEG
            ELSE 
               PROG(IREE)=ASIN(Y)*XRADEG
            ENDIF 
         ENDDO
         SEGDES,MLREEL,MLREE1
         CALL ECROBJ('LISTREEL',IPREEL)
         IF (IERR.NE.0) RETURN
         RETURN
      ENDIF
*
*     CAS DES FLOTTANTS
*
      CALL LIRREE(Y,0,IRETOU)
      IF (IRETOU.EQ.0) GO TO 101
      IF (ABS(Y).GT.XUN) THEN
         IF (ABS(Y).GT.XUNP) THEN
            GOTO 999
         ELSE
            Y=SIGN(XUN,Y)
         ENDIF
      ENDIF
*
      IF (IOPT.EQ.1) THEN
         X = ACOS(Y)*XRADEG
      ELSE 
         X = ASIN(Y)*XRADEG
      ENDIF 
      CALL ECRREE(X)
      RETURN
C
C     ON N'A DONC RIEN TROUVE POUR FAIRE L'OPERATION
C
 101  CONTINUE
      CALL QUETYP(MOTERR(1:8),0,IRETOU)
      IF(IRETOU.NE.0) THEN
*        Opération non prévue entre un %m1:8 et un %m9:16
         CALL LIROBJ(MOTERR(1:8),IRET,1,IRETOU)
         CALL QUETYP(MOTERR(9:16),0,IRETOU)
         IF (IRETOU.EQ.0)  MOTERR(9:16) = '  ????  '
         CALL ERREUR(532)
      ELSE
*        Cet opérateur a encore besoin d'un opérande.
         CALL ERREUR(533)
      ENDIF
      RETURN

 999  CONTINUE
*     Nombre inacceptable %r1
      REAERR(1) = Y
      CALL ERREUR(1009)
      RETURN

      END