Sources Esope | Cast3M

opchp1
C OPCHP1    SOURCE    PV        21/06/30    21:15:01     11052          
      SUBROUTINE OPCHP1(IPO1,IOPERA,IARGU,I1,X1,IPO2,IRET)
C=======================================================================
C
C  ENTREES
C     IPO1  = POINTEUR SUR LE CHPOINT
C     I1    = ENTIER
C     X1    = FLOTTANT
C
C
C Operations elementaires entre un CHPOINT et un ENTIER ou FLOTTANT
C     IOPERA= 1  PUISSANCE
C           = 2  PRODUIT
C           = 3  ADDITION
C           = 4  SOUSTRACTION
C           = 5  DIVISION
C
C Fonctions sur un CHPOINT
C     IOPERA= 6  COSINUS
C           = 7  SINUS
C           = 8  TANGENTE
C           = 9  ARCOSINUS
C           = 10 ARCSINUS
C           = 11 ARCTANGENTE (ATAN A UN ARGUMENT)
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  (renvoie -1 ou +1, resultat du meme type)
C
C     IARGU = 0  ==> ARGUMENT I1I ET X1I INUTILISES
C     IARGU = 1  ==> ARGUMENT I1I UTILISE
C     IARGU = 11 ==> ARGUMENT I1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
C     IARGU = 2  ==> ARGUMENT X1I UTILISE
C     IARGU = 21 ==> ARGUMENT X1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
C
C  SORTIES
C     IPO2  = CHPOINT SOLUTION
C     IRET  = 1 SI L OPERATION EST POSSIBLE
C           = 0 SI L OPERATION EST IMPOSSIBLE
C
C HISTORIQUE :
C   - CB215821             07/12/2015  --> Creation
C   - CB215821             01/09/2016  --> Ajout de l''include TMVALUE
C   - CB215821             05/06/2018  --> Ajout de la fonction SIGN a un argument
C
C=======================================================================
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC SMCHPOI
-INC SMLMOTS
-INC CCASSIS
-INC TMVALUE
 
C     Segment quelconque pour la desactivation des segements
      SEGMENT ISEG(0)
 
      EXTERNAL OPTABi
      LOGICAL  BTHRD
 
C       Pour afficher les lignes gibianes appelees decommenter le CALL
C       CALL TRBAC
 
C======================================================================C
C     Activation des SEGMENTS pour placer les MPOVAL dans le SVALUE
C======================================================================C
      MCHPO1=IPO1
 
C      IF ((IOPERA .EQ. 3) .OR. (IOPERA .EQ. 4)) THEN
CC       Pour les operations + - on n'accepte que les CHPOINT a 1
CC       seule composante.
CC       Pour les fonctions, on traite toutes les composantes en présence
C        CALL EXTR11(IPO1,MLMOTS)
C        SEGACT,MLMOTS
C        JGM=MLMOTS.MOTS(/2)
C        SEGDES,MLMOTS
C        IF(JGM .GT. 1)THEN
C          CALL ERREUR(180)
C          RETURN
C        ENDIF
C      ENDIF
 
      SEGINI,MCHPOI=MCHPO1
      IPO2  =MCHPOI
 
      NSOUPO=MCHPOI.IPCHP(/1)
 
      IF (NSOUPO .EQ. 0)THEN
C       Cas du CHPOINT vide
        IRET = 1
        RETURN
      ENDIF
 
C     Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
C     par thread
      IOPTIM = 100
 
      NBPOIN=NSOUPO
      SEGINI,SVALUE
 
      DO 40 IA=1,NSOUPO
        MSOUP1=MCHPOI.IPCHP(IA)
        SEGINI,MSOUPO=MSOUP1
        MCHPOI.IPCHP(IA)=MSOUPO
        MPOVA1=MSOUPO.IPOVAL
        segact mpova1
        N  = MPOVA1.VPOCHA(/1)
        NC = MPOVA1.VPOCHA(/2)
        NNC=N*NC
        SEGINI,MPOVAL
        MSOUPO.IPOVAL=MPOVAL
        SVALUE.ITYPOI (IA  )= 1
        SVALUE.IPOI0  (IA,1)= MPOVA1
        SVALUE.IPOI1  (IA,1)= 0
        SVALUE.IPOI2  (IA,1)= MPOVAL
        SVALUE.IPOI0  (IA,2)= NNC
        SVALUE.IPOI1  (IA,2)= 0
        SVALUE.IPOI2  (IA,2)= NNC
        IF (IA .EQ. 1) THEN
          NT1 = NNC / IOPTIM
        ELSE
          NT1 = MAX(NT1, NNC/IOPTIM)
        ENDIF
  40  CONTINUE
      SVALUE.NPUTIL=NBPOIN
 
C======================================================================C
C      Partie pour lancer le travail sur les Threads en parallele
C======================================================================C
      ITH = 0
      IF (NBESC .NE. 0) ith=oothrd
C       CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
C                  DEJA DANS LES ASSISTANTS
      IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
        NBTHR = 1
        BTHRD = .FALSE.
      ELSE
        NBTHR = MIN(NT1, NBTHRS)
        BTHRD = .TRUE.
        CALL THREADII
      ENDIF
 
      SEGINI,SPARAL
      SPARAL.NBTHRD = NBTHR
      SPARAL.IVALUE = SVALUE
      SPARAL.IOPE   = IOPERA
      SPARAL.IARG   = IARGU
      SPARAL.I1I    = I1
      SPARAL.X1I    = X1
 
      IF (BTHRD) THEN
C       Remplissage du 'COMMON/optabc'
        IPARAL=SPARAL
        DO ith=2,NBTHR
          CALL THREADID(ith,OPTABi)
        ENDDO
        CALL OPTABi(1)
 
C       Attente de la fin de tous les threads en cours de travail
        DO ith=2,NBTHR
          CALL THREADIF(ith)
        ENDDO
 
C       On libère les Threads
        CALL THREADIS
 
C       Verification de l'erreur (Apres liberation des THREADS)
        DO ith=1,NBTHR
          IRETOU=SPARAL.IERROR(ith)
          IF (IRETOU .GT. 0) THEN
            CALL ERREUR(IRETOU)
            RETURN
          ENDIF
        ENDDO
 
      ELSE
C       Appel de la SUBROUTINE qui fait le travail
        CALL OPTAB0(1,SPARAL)
 
        IRETOU=SPARAL.IERROR(1)
        IF (IRETOU .GT. 0) THEN
          CALL ERREUR(IRETOU)
          RETURN
        ENDIF
      ENDIF
 
      SEGSUP,SVALUE,SPARAL
 
      IRET = 1
      END