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