Télécharger opchel.eso

Retour à la liste

opchel
C OPCHEL    SOURCE    CB215821  20/11/04    21:19:26     10766          
      SUBROUTINE OPCHEL(MCHEL1,IEPS,MCHEL3)
C=====================================================================
C
C     EFFECTUE DIVERSES OPERATIONS SUR DES MCHAML
C  ENTREES
C     MCHEL1=POINTEUR SUR UN MCHAML
C     MCHEL3    (E)  POINTEUR SUR UN MCHAML si appel à ATAN2.
C     IEPS         = 1 COSINUS
C                  = 2 SINUS
C                  = 3 TANGENTE
C                  = 4 ARCOSINUS
C                  = 5 ARCSINUS
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                  =14 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
C                  =15 ARGCH (Fonction reciproque de COSH)
C                  =16 ARGSH (Fonction reciproque de SINH)
C                  =17 ARGTH (Fonction reciproque de TANH)
C                  =18 COTANGENTE (inverse de la tangente)
C
C                  =19 PRODUIT   FLOTTANT *  FLOTTANT
C                  =20 DIVISION  FLOTTANT /  FLOTTANT
C                  =21 PUISSANCE FLOTTANT ** FLOTTANT
C                  =22 PUISSANCE FLOTTANT ** ENTIER
C
C
C  SORTIES
C     MCHEL3=POINTEUR SUR MCHAML RESULTANT
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)
 
      LOGICAL  BATAN2
      INTEGER  IR
C
-INC SMCHAML
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
C
      BATAN2 = .FALSE.
 
      XIN1=XZERO
      XIN2=XZERO
      XOUT=XZERO/XPI
 
      N1PTEL=0
      N2PTEL=0
      N3PTEL=0
      N1EL  =0
      N2EL  =0
      IR    =0
 
 
      SEGACT MCHEL1
      SEGINI,MCHELM=MCHEL1
      N1 = ICHAML(/1)
 
C     ajout lecture second argument pour ATAN2 au lieu de ATAN
      IF(MCHEL3.NE.0) THEN
        SEGACT MCHEL3
        IF (N1.NE.MCHEL3.ICHAML(/1)) GOTO 300
        DO I=1,N1
          IF (IMACHE(I).NE.MCHEL3.IMACHE(I)) GOTO 300
        ENDDO
      ENDIF
 
      DO I = 1,N1
         MCHAM1 = ICHAML(I)
         SEGINI,MCHAML = MCHAM1
         ICHAML(I) = MCHAML
         N2 = IELVAL(/1)
C        Vérif du meme nombre de composante si second argument
         IF(MCHEL3.NE.0) THEN
           MCHAM3 = MCHEL3.ICHAML(I)
           segact,MCHAM3
           IF(MCHAM3.IELVAL(/1).NE.N2) GOTO 302
         ENDIF
C        Vérification que les composantes sont réelles
         DO J = 1,N2
            IF (TYPCHE(J).NE.'REAL*8') THEN
C              Le type %m1:16 de la composante %m17:20 du champ par
C              é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
C           Vérification qu'on a la meme chose pour le second argument
            IF(MCHEL3.NE.0) THEN
              IF(MCHAM3.NOMCHE(J).NE.NOMCHE(J)) GOTO 302
            ENDIF
         ENDDO
C        calcul de l'atan
         DO J = 1,N2
            MELVA1 = IELVAL(J)
            SEGINI,MELVAL=MELVA1
            IELVAL(J) = MELVAL
            NPTEL = VELCHE(/1)
            NEL   = VELCHE(/2)
            IF (MCHEL3.NE.0) THEN
              BATAN2 = .TRUE.
              MELVA3=MCHAM3.IELVAL(J)
              segact,MELVA3
              N3PTEL = MELVA3.VELCHE(/1)
              N3EL   = MELVA3.VELCHE(/2)
              IF (NPTEL.EQ.N3PTEL.AND.NEL.EQ.N3EL)THEN
                DO K = 1,NEL
                  DO L = 1,NPTEL
                    XIN1 = VELCHE(L,K)
                    XIN2 = MELVA3.VELCHE(L,K)
                    CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
                    VELCHE(L,K) = XOUT
                  ENDDO
                ENDDO
              ELSE
C               il faut faire attention aux champs constants
                N1PTEL = max(NPTEL,N3PTEL)
                N1EL   = max(NEL,  N3EL)
                segadj,MELVAL
                segact,MELVA1
                DO K1 = 1,N1EL
                  K  = MIN(K1,NEL)
                  K3 = MIN(K3,N3EL)
                  DO L1 = 1,N1PTEL
                    L  = MIN(L1,NPTEL)
                    L3 = MIN(L1,N3PTEL)
 
                    XIN1 = MELVA1.VELCHE(L,K)
                    XIN2 = MELVA3.VELCHE(L3,K3)
                    CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
                    VELCHE(L,K) = XOUT
                  ENDDO
                ENDDO
                segdes,MELVA1
              ENDIF
              SEGDES,MELVA3
            ELSE
              DO K = 1,NEL
               DO L = 1,NPTEL
                  XIN1 = VELCHE(L,K)
                  CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
                  VELCHE(L,K) = XOUT
               ENDDO
              ENDDO
            ENDIF
            SEGDES,MELVAL
         ENDDO
         SEGDES,MCHAM1
         SEGDES,MCHAML
      ENDDO
 
      SEGDES MCHELM
      MCHEL3 = MCHELM
      RETURN
 
C     gestion des erreurs
 302  CALL ERREUR(488)
 
      DO K = 1,I
        MCHAML = ICHAML(K)
        SEGSUP MCHAML
        MCHAM3 = MCHEL3.ICHAML(K)
        segdes,MCHAM3
      ENDDO
 
      goto 299
 
 300  CALL ERREUR(329)
 
 299  segdes,MCHEL3,MCHEL1
      segsup,MCHELM
      RETURN
 
      END
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales