Sources Esope | Cast3M

oplent
C OPLENT    SOURCE    CB215821  23/10/18    21:15:08     11760          
      SUBROUTINE OPLENT(IPO1, IOPERA, IPO3)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C                             O P L E N T
C                             -----------
C
C FONCTION:
C ---------
C
C     EFFECTUE DIVERSES OPERATIONS SUR UN LISTENTI.
C
C MODULES UTILISES:
C -----------------
C
C
C PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
C -----------
C
C     IPO1    (E)  POINTEUR SUR UN LISTENTI.
C     IPO3    (E)  POINTEUR SUR UN LISTENTI si appel à ATAN2
C
C  ENTREE
C     IOPERA= 1  PUISSANCE
C           = 2  PRODUIT
C           = 3  ADDITION
C           = 4  SOUSTRACTION
C           = 5  DIVISION
C
C     IOPERA= 6  COSINUS
C           = 7  SINUS
C           = 8  TANGENTE
C           = 9  ARCOSINUS
C           = 10 ARCSINUS
C           = 11 ARCTANGENTE
C           = 12 EXPONENTIELLE
C           = 13 LOGARITHME
C           = 14 VALEUR ABSOLUE
C           = 15 COSINUS  HYPERBOLIQUE
C           = 16 SINUS    HYPERBOLIQUE
C           = 17 TANGENTE HYPERBOLIQUE
C           = 18 ERF  FONCTION D'ERRREUR DE GAUSS
C           = 19 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
C           = 20 ARGCH (Fonction reciproque de COSH)
C           = 21 ARGSH (Fonction reciproque de SINH)
C           = 22 ARGTH (Fonction reciproque de TANH)
C           = 23 SIGN(1.D0,XIN1)
C
C     IPO3    (S)  POINTEUR SUR LE LISTREEL RESULTAT.
C                  = 0 , SI OPERATION IMPOSSIBLE.
C
C HISTORIQUE :
C   - CB215821             12/04/1988  --> Creation
C   - CB215821             05/09/1988  --> AJOUT DE "EXP" ET "LOG"
C   - CB215821             18/07/1990  --> AJOUT DE "SIN" ET "COS"
C   - CB215821             24/07/2014  --> REMANIEMENT : APPEL A OPFLOT
C   - CB215821             05/06/2018  --> Ajout de la fonction SIGN a un argument
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      LOGICAL BATAN2
      REAL*8  XIN1,XIN2,XOUT
      INTEGER I,LDIM1,LDIM2,IR1,IR2,IPO1,IR
 
C
-INC PPARAM
-INC CCOPTIO
C-INC CCREEL
-INC SMLREEL
-INC SMLENTI
 
      SEGMENT ISEG(0)
 
      BATAN2 = .FALSE.
 
      IR   =0
      IR1  =0
      IR2  =0
      LDIM1=0
      LDIM2=0
 
      XIN1 = 0.D0
      XIN2 = 0.D0
 
      MLENTI = IPO1
      SEGACT MLENTI
      LDIM1 = MLENTI.LECT(/1)
 
      IF ( IPO3 .NE. 0 ) THEN
        MLENT2 = IPO3
        SEGACT MLENT2
        LDIM2 = MLENT2.LECT(/1)
 
C       Les deux objets doivent être de même taille
        IF (LDIM1 .NE. LDIM2 ) THEN
          SEGDES,MLENT2,MLENTI
          CALL ERREUR(217)
          RETURN
        ENDIF
 
        BATAN2 = .TRUE.
      ENDIF
 
      JG = LDIM1
 
C     Resultat LISTENTI attendu pour ABS (IOPERA = 14 OU 23)
      IF (IOPERA .EQ. 14 .OR. IOPERA .EQ. 23) THEN
        SEGINI MLENT1
        IPO3 = MLENT1
 
        DO 10 I = 1,LDIM1
          IR1 = MLENTI.LECT(I)
          CALL OPENTI(IR1,IR2,BATAN2,IOPERA,IOUT,XOUT)
          MLENT1.LECT(I) = IOUT
 10     CONTINUE
 
      ELSE
        SEGINI MLREE1
        IF ( BATAN2 .EQV. .TRUE. ) THEN
          SEGINI MLREE2
        ENDIF
 
C       Conversion en LISTREEL
        DO 11 I = 1,LDIM1
          MLREE1.PROG(I) =REAL(MLENTI.LECT(I))
 11     CONTINUE
 
        IF ( BATAN2 .EQV. .TRUE. ) THEN
          DO 12 I = 1,LDIM1
            MLREE2.PROG(I) =REAL(MLENT2.LECT(I))
 12       CONTINUE
        ENDIF
 
        IARGU = 0
        CALL OPLRE1(MLREE1,IOPERA,IARGU,0,0.D0,MLREE2,IRET)
C       MLREE2 est modifie en sortie !
        IPO3 = MLREE2
      ENDIF
 
      RETURN
      END