C TANGEN    SOURCE    PV        09/03/12    21:35:18     6325           
C ARCCS
      SUBROUTINE tangen
*=============================================================
*
*  Tangente d'un angle en degrés
*
*=============================================================
*
*  Syntaxe :
*
*      RESU1 =  'TAN'  OBJET1  ('NOVERIF') ;
*
*=============================================================
*
*  Création      : Maugis 24/09/2007
*
*  Modifications : Gounand 18/12/2007 
*                  l'option 'NOVERIF' paraît superflue
*
*=============================================================
*
*  REMARQUES:
*    produit une erreur, en l'absence du mot-clef 'NOVERIF' si
*    on donne 90 [180] en entrée.
*
*=============================================================
*
*  LVERIF : logique, vrai => erreur si angle = 90° [180°]
*                    faux => retourne XGRAND/10 du signe de l'entrée
*
*=============================================================
      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))
      CHARACTER*8 ITYP
*SG      CHARACTER*4 MCLE2(1)
*SG      DATA        MCLE2/'NOVE'/
*SG      LOGICAL     LVERIF

*     Un objet de type CHPOINT, LISTREEL, ENTIER ou FLOTTANT est attendu.
      CALL MESLIR(-134)

*     Présence du mot-clef 'NOVERIF'
*      CALL LIRMOT(MCLE2,1,ICLE,0)
*      LVERIF = (ICLE.EQ.0)

*     Facteur de conversion degrés -> radian
      XDEGRA = XPI / 180.D0
*
*     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)
C SG
C                  IF ((ABS(MOD(ABS(Y),180D0)-90D0)).LT.XPETIT) THEN
C                     IF (LVERIF) THEN
C                        SEGDES MPOVAL,MSOUPO,MCHPOI
C                        GOTO 999
C                     ELSE
C                        VPOCHA(J,K) = SIGN(.1D0,Y) * XGRAND
C                     ENDIF 
C                  ELSE 
                     VPOCHA(J,K) = TAN(Y*XDEGRA)
C                  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)
C SG
C                     IF ((ABS(MOD(ABS(Y),180D0)-90D0)).LT.XPETIT) THEN
C                        IF (LVERIF) THEN
C                           SEGDES,MELVAL,MCHAM1,MCHAML
C                           GOTO 999
C                        ELSE
C                           VELCHE(L,K) = SIGN(.1D0,Y) * XGRAND
C                        ENDIF 
C                     ELSE 
                        VELCHE(L,K) = TAN(Y*XDEGRA)
C                     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)
C SG
C            IF ((ABS(MOD(ABS(Y),180D0)-90D0)).LT.XPETIT) THEN
C               IF (LVERIF) THEN
C                  SEGDES,MLREEL,MLREE1
C                  GOTO 999
C               ELSE
C                  PROG(IREE) = SIGN(.1D0,Y) * XGRAND
C               ENDIF 
C            ELSE 
               PROG(IREE) = TAN(Y*XDEGRA)
C            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
C SG
C      IF ((ABS(MOD(ABS(Y),180D0)-90D0)).LT.XPETIT) THEN
C         IF (LVERIF) THEN
C            GOTO 999
C         ELSE
C            X = SIGN(.1D0,Y) * XGRAND
C         ENDIF 
C      ELSE 
         X = TAN(Y*XDEGRA)
C      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
*SG Le message d'erreur suivant est bizarre (affichage d'un réel
* 
*     Nombre inacceptable %r1
      REAERR(1) = Y
      CALL ERREUR(1009)
      RETURN

      END