Télécharger la plaquette Cast3M


fr en

Télécharger optabj.eso

Retour à la liste

Numérotation des lignes : 

optabj

  1. C OPTABJ    SOURCE    CB215821  23/10/18    21:15:09     11760          
  2.       SUBROUTINE OPTABj(NBTHR ,ITHR,IOPERA,NTABEN,
  3.      &                  XVAL0,XVAL1,XVAL2,
  4.      &                  NN0  ,NN1  ,NN2  ,IARG ,I1I  ,X1I ,IRETOU)
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C     Cette subroutine effectue des operations elementaires ainsi que
  7. C     les fonctions sur des tableaux FORTRAN de REAL*8
  8. C     Elle est prevue pour etre executee en parallele
  9. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. C     NBTHR  : Nombre de Thread disponibles
  11. C     ITHR   : Numero du Thread courant
  12. C     IRETOU : Entier contenant le code d'erreur
  13. C     IOPERA : Type d''operation a realiser (Voir ci-dessous)
  14. C     NTABEN : Nombre de tableaux constituant l''entree (Exemple : 2 pour ATAN2)
  15. C     XVAL0  : Tableau de valeur d''entree
  16. C     XVAL1  : Tableau de valeur d''entree (Deuxieme argument pour ATAN2)
  17. C     XVAL2  : Tableau de valeur de sortie
  18. C     NN0    : Taille  du tableau XVAL0
  19. C     NN1    : Taille  du tableau XVAL1
  20. C     NN2    : Taille  du tableau XVAL2
  21. C
  22. C     IARG  = 0  ==> ARGUMENT I1I ET X1I INUTILISES
  23. C     IARG  = 1  ==> ARGUMENT I1I UTILISE
  24. C     IARG  = 11 ==> ARGUMENT I1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (PUISSANCE, SOUSTRACTION, DIVISION : POSITIONNEL)
  25. C     IARG  = 2  ==> ARGUMENT X1I UTILISE
  26. C     IARG  = 21 ==> ARGUMENT X1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (PUISSANCE, SOUSTRACTION, DIVISION : POSITIONNEL)
  27. C
  28. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  29. C
  30. C Elle realise les operations suivantes :
  31. C Operations elementaires entre un TABLEAU et un ENTIER ou FLOTTANT
  32. C     IOPERA= 1  PUISSANCE
  33. C           = 2  PRODUIT
  34. C           = 3  ADDITION
  35. C           = 4  SOUSTRACTION
  36. C           = 5  DIVISION
  37. C
  38. C Fonctions sur un TABLEAU
  39. C           = 6  COSINUS
  40. C           = 7  SINUS
  41. C           = 8  TANGENTE
  42. C           = 9  ARCOSINUS
  43. C           = 10 ARCSINUS
  44. C           = 11 ARCTANGENTE
  45. C           = 12 EXPONENTIELLE
  46. C           = 13 LOGARITHME
  47. C           = 14 VALEUR ABSOLUE
  48. C           = 15 COSINUS  HYPERBOLIQUE
  49. C           = 16 SINUS    HYPERBOLIQUE
  50. C           = 17 TANGENTE HYPERBOLIQUE
  51. C           = 18 ERF  FONCTION D''ERRREUR DE GAUSS
  52. C           = 19 ERFC FONCTION D''ERRREUR COMPLEMENTAIRE DE GAUSS (1-ERF(X))
  53. C           = 20 ARGCH (FONCTION RECIPROQUE DE COSH)
  54. C           = 21 ARGSH (FONCTION RECIPROQUE DE SINH)
  55. C           = 22 ARGTH (FONCTION RECIPROQUE DE TANH)
  56. C           = 23 SIGN  (renvoie -1 ou +1)
  57. C           = 24 BESSEL J0
  58. C           = 25 BESSEL J1
  59. C           = 26 BESSEL Y0
  60. C           = 27 BESSEL Y1
  61. C           = 28 FRESNEL CX
  62. C           = 29 FRESNEL SX
  63. C           = 30 GAMMA (Fonction Gamma d'Euler)
  64. C           = 31 BESSEL JN (Fonction BESSEL de type J d'ordre N)
  65. C           = 32 BESSEL YN (Fonction BESSEL de type Y d'ordre N)
  66. C HISTORIQUE :
  67. C   - CB215821             31/08/2016  --> Creation
  68. C   - CB215821             05/06/2018  --> Ajout de la fonction SIGN a un argument
  69. C   - CB215821             17/10/2023  --> Ajout des fonctions BESSEL, FRESNEL et GAMMA
  70. C
  71. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  72.  
  73.       IMPLICIT INTEGER(I-N)
  74.       IMPLICIT REAL*8 (A-H,O-Z)
  75.  
  76. -INC CCREEL
  77.  
  78. -INC PPARAM
  79. -INC CCOPTIO
  80.  
  81.       SEGMENT ITOTO(0)
  82.  
  83.       INTEGER NTABEN
  84.  
  85.       REAL*8 XNOR,XINV,XFLOT,XFLOT1,XFLOT2,XIINV,XPREC,XTRA,X2,XF1,UN
  86.  
  87.       PARAMETER (XNOR = XPI / 180.D0)
  88.       PARAMETER (XINV = 180.D0 / XPI)
  89.       PARAMETER (UN   = 1.D0)
  90.  
  91.       REAL*8    XVAL0(NN0),XVAL1(NN1),XVAL2(NN2)
  92.  
  93.       INTEGER   IRETOU
  94.  
  95.       I2     = I1I
  96.       X2     = X1I
  97.       IARG2  = IARG
  98.       IRETOU = 0
  99.  
  100. C     On assure le travail contigu en memoire
  101.       NNC   = MAX(NN0,NN1,NN2)
  102.       IF(NBTHR .EQ. 1)THEN
  103.         IDEB  = 1
  104.         IFIN  = NNC
  105.       ELSE
  106.         IRES = MOD(NNC,NBTHR)
  107.         IF(IRES  .EQ. 0)THEN
  108.           ILON  = NNC / NBTHR
  109.           IDEB  = (ithr -1)* ILON + 1
  110.         ELSE
  111.           IF (ithr .LE. IRES) THEN
  112.             ILON  = (NNC / NBTHR) + 1
  113.             IDEB  = (ithr -1)* ILON + 1
  114.           ELSE
  115.             ILON  = NNC / NBTHR
  116.             IDEB  = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  117.           ENDIF
  118.         ENDIF
  119.         IFIN  = IDEB + ILON - 1
  120.       ENDIF
  121. C     PRINT *, 'OPTABJ:',ITHR,IOPERA,NN0,NTABEN
  122.  
  123.       IF (NTABEN .EQ. 2) GOTO 5000
  124.  
  125. C======================================================================C
  126. C               OPERATIONS ENTRE UN TABLEAU ET UN FLOTTANT / ENTIER
  127. C======================================================================C
  128. C      IF    (IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) THEN
  129. C        X2 = REAL(I1I)
  130. C      ELSEIF(IARG2 .NE. 0 .AND. IARG2 .NE. 2 .AND. IARG2 .NE. 21) THEN
  131. C       Surveillance de la validite des PARAMETRES d'entree
  132. C        IRETOU = 21
  133. C        RETURN
  134. C      ENDIF
  135.  
  136.       GOTO ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,
  137.      &      18,19,20,21,22,23,24,25,26,27,28,29,30,31,32 ),IOPERA
  138.  
  139. C     Erreur si l''operation demandee n''est pas dans la liste
  140.       IRETOU = 21
  141.       RETURN
  142.  
  143. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  144. C                                   PUISSANCE
  145. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  146.  1    CONTINUE
  147.       IF (IARG2 .EQ. 1) THEN
  148. C        PRINT *,'TABLEAU ** ENTIER',ITHR
  149.         IF (I2 .EQ. 0) THEN
  150. C          PRINT *,'  Cas TABLEAU ** 0'
  151.           DO 101 IA = IDEB,IFIN
  152.               XVAL2(IA)= REAL(1.D0)
  153.   101     CONTINUE
  154.           RETURN
  155.  
  156.         ELSEIF(I2 .EQ. 1)THEN
  157. C          PRINT *,'  Cas TABLEAU ** 1'
  158.           DO 102 IA = IDEB,IFIN
  159.               XVAL2(IA)= XVAL0(IA)
  160.   102     CONTINUE
  161.           RETURN
  162.  
  163.         ELSE
  164.           DO 103 IA = IDEB,IFIN
  165.             XTRA=XVAL0(IA)
  166.             IF(ABS(XTRA).LE.XPETIT .AND. I2.LT.0)THEN
  167.               IRETOU = 213
  168.               RETURN
  169.             ELSE
  170.               XVAL2(IA)= XTRA ** I2
  171.             ENDIF
  172.   103     CONTINUE
  173.           RETURN
  174.         ENDIF
  175.         RETURN
  176.  
  177.       ELSEIF(IARG2 .EQ. 2) THEN
  178. C        PRINT *,'TABLEAU ** FLOTTANT',ITHR
  179.         I2    = NINT(X2)
  180.         XFLOT = ABS(X2 - REAL(I2))
  181.         XPREC = XZPREC*ABS(X2)
  182.  
  183. C       Verification si puissance ENTIERE possible
  184.         IF ( XFLOT .LE. XPREC) THEN
  185.           IARG2=1
  186.           GOTO 1
  187.         ENDIF
  188.  
  189. C       Verification si SQRT possible
  190.         XF1   = X2 - REAL(0.5D0)
  191.         I2    = NINT(XF1)
  192.         I3    = (I2 * 2) + 1
  193.         XFLOT = ABS(XF1 - REAL(I2))
  194.         IF (XFLOT .LE. XPREC) THEN
  195.           IF (I2 .EQ. 0) THEN
  196. C            PRINT *,'  Cas SQRT simple'
  197.             DO 104 IA = IDEB,IFIN
  198.               IF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  199.                 IRETOU = 213
  200.                 RETURN
  201.               ELSE
  202.                 XVAL2(IA)= SQRT(XVAL0(IA))
  203.               ENDIF
  204.   104       CONTINUE
  205.             RETURN
  206.  
  207.           ELSE
  208. C            PRINT *,'  Nouveau cas SQRT ** I3',I3
  209.             DO 105 IA = IDEB,IFIN
  210.               IF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  211.                 IRETOU = 213
  212.                 RETURN
  213.               ELSE
  214.                 XVAL2(IA)= (SQRT(XVAL0(IA))) ** I3
  215.               ENDIF
  216.   105       CONTINUE
  217.             RETURN
  218.           ENDIF
  219.           RETURN
  220.  
  221.         ELSE
  222. C         Verification si racine Nieme possible
  223.           IF (X2 .GT. XPETIT) THEN
  224.             XIINV=UN/X2
  225.             IINV = NINT(XIINV)
  226.             XFLOT= ABS(XIINV - REAL(IINV))
  227.             XPREC= XZPREC*ABS(XIINV)
  228.  
  229.             IF (XFLOT .LE. XPREC .AND. MOD(IINV,2).NE. 0) THEN
  230. C              PRINT *,'  Racine Nieme'
  231.               DO 106 IA = IDEB,IFIN
  232.                 XFLOT = XVAL0(IA)
  233.                 XVAL2(IA)=SIGN(UN,XFLOT)*(ABS(XFLOT)**X2)
  234.   106         CONTINUE
  235.               RETURN
  236.             ENDIF
  237.           ENDIF
  238.  
  239. C          PRINT *,'  Cas general'
  240.           DO 107 IA = IDEB,IFIN
  241.             IF ((ABS(XVAL0(IA)) .LE. XPETIT) .AND.
  242.      &          (X2 .LT. REAL(0.D0))) THEN
  243.               IRETOU = 213
  244.               RETURN
  245.             ELSEIF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  246.               IRETOU = 213
  247.               RETURN
  248.             ELSE
  249.               XVAL2(IA)= XVAL0(IA) ** X2
  250.             ENDIF
  251.   107     CONTINUE
  252.           RETURN
  253.         ENDIF
  254.         RETURN
  255.  
  256.       ELSEIF(IARG2 .EQ. 11 .OR. IARG2 .EQ. 21) THEN
  257. C        PRINT *,'ENTIER ** TABLEAU  ou FLOTTANT ** TABLEAU'
  258.         IF(IARG2 .EQ. 11) X2 = REAL(I1I)
  259.         DO 108 IA = IDEB,IFIN
  260.           I2    = NINT(XVAL0(IA))
  261.           XFLOT1= ABS(XVAL0(IA) - REAL(I2   ))
  262.           XFLOT2= ABS(XVAL0(IA) - REAL(0.5D0))
  263.           XPREC = XZPREC*ABS(XVAL0(IA))
  264.           IF (((ABS(X2) .LE. XPETIT) .AND.
  265.      &         (XVAL0(IA).LT.REAL(0.D0) )) .OR.
  266.      &            (X2 .LT. REAL(0.D0))) THEN
  267.             IRETOU = 213
  268.             RETURN
  269.           ELSEIF ( XFLOT1 .LE. XPREC ) THEN
  270. C            PRINT *,'  Puissance Entiere Possible'
  271.             XVAL2(IA)= X2 ** I2
  272.           ELSEIF ( XFLOT2 .LE. XPREC) THEN
  273. C            PRINT *,'  SQRT Possible'
  274.             XVAL2(IA)= SQRT(X2)
  275.           ELSE
  276. C            PRINT *,'  Cas general'
  277.             XVAL2(IA)= X2 ** XVAL0(IA)
  278.           ENDIF
  279.   108   CONTINUE
  280.         RETURN
  281.       ENDIF
  282.       RETURN
  283.  
  284. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  285. C                                   PRODUIT
  286. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  287.  2    CONTINUE
  288.       IF(IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) THEN
  289.         IF (I1I .EQ. 0) RETURN
  290.         X2 = REAL(I1I)
  291.       ENDIF
  292.  
  293.       IF(ABS(1.D0-X2) .LE. XZPREC)THEN
  294.         IF(SIGN(1.D0,X2) .LT. 0.D0)THEN
  295.           DO 201 IA = IDEB,IFIN
  296.             XVAL2(IA)=-XVAL0(IA)
  297.   201     CONTINUE
  298.         ELSE
  299.           DO 202 IA = IDEB,IFIN
  300.             XVAL2(IA)= XVAL0(IA)
  301.   202     CONTINUE
  302.         ENDIF
  303.       ELSE
  304.         DO 203 IA = IDEB,IFIN
  305.           XVAL2(IA)= XVAL0(IA) * X2
  306.   203   CONTINUE
  307.       ENDIF
  308.       RETURN
  309.  
  310. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  311. C                                  ADDITION
  312. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  313.  3    CONTINUE
  314.       IF    ((IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) .AND. (I1I .EQ. 0)) THEN
  315. C        PRINT *,'ADDITION Cas 1'
  316.         DO 301 IA=IDEB,IFIN
  317.           XVAL2(IA) = XVAL0(IA)
  318.   301   CONTINUE
  319.         RETURN
  320.       ENDIF
  321.  
  322.       IF(IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) X2 = REAL(I1I)
  323. C      PRINT *,'ADDITION Cas 2'
  324.       DO 303 IA=IDEB,IFIN
  325.         XVAL2(IA) = XVAL0(IA) + X2
  326.   303 CONTINUE
  327.       RETURN
  328.  
  329. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  330. C                                 SOUSTRACTION
  331. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  332.  4    CONTINUE
  333.       IF    (IARG2 .EQ. 1 .AND. I1I .EQ. 0) THEN
  334. C        PRINT *,'SOUSTRACTION Cas 1'
  335.         DO 401 IA=IDEB,IFIN
  336.           XVAL2(IA) = XVAL0(IA)
  337.   401   CONTINUE
  338.         RETURN
  339.       ENDIF
  340.       IF    (IARG2 .EQ. 11 .AND. I1I .EQ. 0) THEN
  341. C        PRINT *,'SOUSTRACTION Cas 2'
  342.         DO 403 IA=IDEB,IFIN
  343.           XVAL2(IA) = -XVAL0(IA)
  344.   403   CONTINUE
  345.         RETURN
  346.       ENDIF
  347.       IF (IARG2 .EQ. 1) THEN
  348. C       Cas TABLEAU - I1I
  349. C       PRINT *,'SOUSTRACTION Cas 3'
  350.         X2 = REAL(I1I)
  351.         DO 405 IA = IDEB,IFIN
  352.           XVAL2(IA)= XVAL0(IA) - X2
  353.   405   CONTINUE
  354.         RETURN
  355.       ELSEIF(IARG2 .EQ. 2) THEN
  356. C       Cas TABLEAU - X2
  357. C       PRINT *,'SOUSTRACTION Cas 4'
  358.         DO 406 IA = IDEB,IFIN
  359.           XVAL2(IA)= XVAL0(IA) - X2
  360.   406   CONTINUE
  361.         RETURN
  362.       ELSEIF(IARG2 .EQ. 11) THEN
  363. C       Cas I1I - TABLEAU
  364. C       PRINT *,'SOUSTRACTION Cas 5'
  365.         X2 = REAL(I1I)
  366.         DO 407 IA = IDEB,IFIN
  367.           XVAL2(IA)= X2 - XVAL0(IA)
  368.   407   CONTINUE
  369.         RETURN
  370.       ELSEIF(IARG2 .EQ. 21) THEN
  371. C       Cas X2 - TABLEAU
  372. C       PRINT *,'SOUSTRACTION Cas 6'
  373.         DO 408 IA = IDEB,IFIN
  374.           XVAL2(IA)= X2 - XVAL0(IA)
  375.   408   CONTINUE
  376.         RETURN
  377.       ENDIF
  378.       RETURN
  379.  
  380. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  381. C                                 DIVISION
  382. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  383.  5    CONTINUE
  384.       IF(IARG2 .EQ. 11 .AND. I1I .EQ. 0) THEN
  385. C        PRINT *,'DIVISION Cas 1'
  386.         RETURN
  387. C      ELSEIF(IARG2 .EQ. 21 .AND. (ABS(X2) .LE. XPETIT)) THEN
  388. CC        PRINT *,'DIVISION Cas 2' XPETIT divise par qqc n'est pas forcement negligeable !!!
  389. C        RETURN
  390.       ENDIF
  391.       IF     (IARG2 .EQ. 1) THEN
  392.         IF (I1I .NE. 0) THEN
  393. C          PRINT *,'DIVISION Cas 3'
  394.           X2 = REAL(I1I)
  395.           DO 501 IA = IDEB,IFIN
  396. C           Cas TABLEAU / ENTIER
  397.             XVAL2(IA)= XVAL0(IA) / X2
  398.   501     CONTINUE
  399.           RETURN
  400.         ELSE
  401.           IRETOU = 835
  402.           RETURN
  403.         ENDIF
  404.       ELSEIF (IARG2 .EQ. 2) THEN
  405.         IF (ABS(X2) .GT. XPETIT) THEN
  406. C          PRINT *,'DIVISION Cas 4'
  407.           X3 = 1.D0 / X2
  408.           DO 502 IA = IDEB,IFIN
  409. C           Cas TABLEAU / FLOTTANT
  410.             XVAL2(IA)= XVAL0(IA) * X3
  411.   502     CONTINUE
  412.           RETURN
  413.         ELSE
  414.           IRETOU = 835
  415.           RETURN
  416.         ENDIF
  417.       ELSEIF(IARG2 .EQ. 11 .OR. IARG2 .EQ. 21) THEN
  418. C        PRINT *,'DIVISION Cas 5'
  419.         IF (IARG2 .EQ. 11) X2 = REAL(I1I)
  420.         DO 503 IA = IDEB,IFIN
  421. C         Cas FLOTTANT / TABLEAU ou ENTIER / TABLEAU (terme a terme)
  422.           IF (ABS(XVAL0(IA)) .GT. XPETIT) THEN
  423.             XVAL2(IA)= X2 / XVAL0(IA)
  424.           ELSE
  425.             IRETOU = 835
  426.             RETURN
  427.           ENDIF
  428.   503   CONTINUE
  429.         RETURN
  430.       ENDIF
  431.       RETURN
  432.  
  433. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  434. C                                 COSINUS
  435. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  436.  6    CONTINUE
  437.       DO 601 IA = IDEB,IFIN
  438.         XVAL2(IA)= COS(XNOR * XVAL0(IA))
  439.   601 CONTINUE
  440.       RETURN
  441.  
  442. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  443. C                                 SINUS
  444. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  445.  7    CONTINUE
  446.       DO 701 IA = IDEB,IFIN
  447.         XVAL2(IA)= SIN(XNOR * XVAL0(IA))
  448.   701 CONTINUE
  449.       RETURN
  450.  
  451. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  452. C                                 TANGENTE
  453. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  454.  8    CONTINUE
  455.       DO 801 IA = IDEB,IFIN
  456.         XVAL2(IA)= TAN(XNOR * XVAL0(IA))
  457.   801 CONTINUE
  458.       RETURN
  459.  
  460. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  461. C                                 ARCCOS
  462. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  463.  9    CONTINUE
  464.       DO 901 IA = IDEB,IFIN
  465.         X2 = XVAL0(IA)
  466.         IF (ABS(X2) .LE. UN) THEN
  467.           XVAL2(IA)= XINV * ACOS(X2)
  468.         ELSE
  469.           IRETOU = 21
  470.           RETURN
  471.         ENDIF
  472.   901 CONTINUE
  473.       RETURN
  474.  
  475. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  476. C                                 ARCSIN
  477. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  478.  10   CONTINUE
  479.       DO 1001 IA = IDEB,IFIN
  480.         X2 = XVAL0(IA)
  481.         IF (ABS(X2) .LE. UN) THEN
  482.           XVAL2(IA)= XINV * ASIN(X2)
  483.         ELSE
  484.           IRETOU = 21
  485.           RETURN
  486.         ENDIF
  487.  1001 CONTINUE
  488.       RETURN
  489.  
  490. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  491. C                                 ARCTANGENTE
  492. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  493.  11   CONTINUE
  494.       DO 1101 IA = IDEB,IFIN
  495.         XVAL2(IA)= XINV * ATAN(XVAL0(IA))
  496.  1101 CONTINUE
  497.       RETURN
  498.  
  499. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  500. C                                 EXPONENTIELLE
  501. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  502.  12   CONTINUE
  503.       DO 1201 IA = IDEB,IFIN
  504.         XVAL2(IA)= EXP(XVAL0(IA))
  505.  1201 CONTINUE
  506.       RETURN
  507.  
  508. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  509. C                                 LOGARITHME
  510. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  511.  13   CONTINUE
  512.       DO 1301 IA = IDEB,IFIN
  513.         X2 = XVAL0(IA)
  514.         IF    (X2 .GE. REAL(0.D0) .AND. X2 .LE. XPETIT) THEN
  515.           XVAL2(IA)=-1.D0*XGRAND
  516.         ELSEIF(X2 .GT. XPETIT) THEN
  517.           XVAL2(IA)= LOG(X2)
  518.         ELSE
  519.           IRETOU = 21
  520.           RETURN
  521.         ENDIF
  522.  1301 CONTINUE
  523.       RETURN
  524.  
  525. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  526. C                               VALEUR ABSOLUE
  527. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  528.  14   CONTINUE
  529.       DO 1401 IA = IDEB,IFIN
  530.         XVAL2(IA)= ABS(XVAL0(IA))
  531.  1401 CONTINUE
  532.       RETURN
  533.  
  534. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  535. C                            COSINUS HYPERBOLIQUE
  536. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  537.  15   CONTINUE
  538.       DO 1501 IA = IDEB,IFIN
  539.         XVAL2(IA)= COSH(XVAL0(IA))
  540.  1501 CONTINUE
  541.       RETURN
  542.  
  543. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  544. C                            SINUS HYPERBOLIQUE
  545. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  546.  16   CONTINUE
  547.       DO 1601 IA = IDEB,IFIN
  548.         XVAL2(IA)= SINH(XVAL0(IA))
  549.  1601 CONTINUE
  550.       RETURN
  551.  
  552. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  553. C                            TANGENTE HYPERBOLIQUE
  554. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  555.  17   CONTINUE
  556.       DO 1701 IA = IDEB,IFIN
  557.         XVAL2(IA)= TANH(XVAL0(IA))
  558.  1701 CONTINUE
  559.       RETURN
  560.  
  561. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  562. C                            ERF (Fonction Erreur)
  563. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  564.  18   CONTINUE
  565.       DO 1801 IA = IDEB,IFIN
  566.         XVAL2(IA)= ERF(XVAL0(IA))
  567.  1801 CONTINUE
  568.       RETURN
  569.  
  570. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  571. C               ERFC (Fonction Erreur Complementaire 1-ERF(x))
  572. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  573.  19   CONTINUE
  574.       DO 1901 IA = IDEB,IFIN
  575.         XVAL2(IA)= ERFC(XVAL0(IA))
  576.  1901 CONTINUE
  577.       RETURN
  578.  
  579. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  580. C                                 ARCOSH
  581. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  582.  20   CONTINUE
  583.       DO 2001 IA = IDEB,IFIN
  584.         X2 = XVAL0(IA)
  585.         IF (X2 .GE. UN) THEN
  586.           XVAL2(IA)= LOG(X2 + SQRT((X2**2) - UN))
  587.         ELSE
  588.           IRETOU = 21
  589.           RETURN
  590.         ENDIF
  591.  2001 CONTINUE
  592.       RETURN
  593.  
  594. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  595. C                                 ARSINH
  596. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  597.  21   CONTINUE
  598.       DO 2101 IA = IDEB,IFIN
  599.         X2 = XVAL0(IA)
  600.         XVAL2(IA)= LOG(X2 + SQRT((X2**2) + UN))
  601.  2101 CONTINUE
  602.       RETURN
  603.  
  604. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  605. C                                 ARTANH
  606. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  607.  22   CONTINUE
  608.       DO 2201 IA = IDEB,IFIN
  609.         X2 = XVAL0(IA)
  610.         IF (ABS(X2) .LT. UN) THEN
  611.           XVAL2(IA)=REAL(0.5D0)*LOG((UN+X2) / (UN - X2))
  612.         ELSE
  613.           IRETOU = 21
  614.           RETURN
  615.         ENDIF
  616.  2201 CONTINUE
  617.       RETURN
  618.  
  619. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  620. C                                 SIGN
  621. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  622.  23   CONTINUE
  623.       DO 2301 IA = IDEB,IFIN
  624.         XVAL2(IA)= SIGN(UN,XVAL0(IA))
  625.  2301 CONTINUE
  626.       RETURN
  627.  
  628. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  629. C                                 BESSEL J0 (Fortran 2008)
  630. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  631.  24   CONTINUE
  632.       DO 2401 IA = IDEB,IFIN
  633.         XVAL2(IA)= BESSEL_J0(XVAL0(IA))
  634.  2401 CONTINUE
  635.       RETURN
  636.  
  637. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  638. C                                 BESSEL J1 (Fortran 2008)
  639. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  640.  25   CONTINUE
  641.       DO 2501 IA = IDEB,IFIN
  642.         XVAL2(IA)= BESSEL_J1(XVAL0(IA))
  643.  2501 CONTINUE
  644.       RETURN
  645.  
  646. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  647. C                                 BESSEL Y0 (Fortran 2008)
  648. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  649.  26   CONTINUE
  650.       DO 2601 IA = IDEB,IFIN
  651.         X0 = XVAL0(IA)
  652.         IF (X0 .GT. XZERO) THEN
  653.           XVAL2(IA)= BESSEL_Y0(XVAL0(IA))
  654.         ELSE
  655.           IRETOU = 21
  656.           RETURN
  657.         ENDIF
  658.  2601 CONTINUE
  659.       RETURN
  660.  
  661. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  662. C                                 BESSEL Y1 (Fortran 2008)
  663. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  664.  27   CONTINUE
  665.       DO 2701 IA = IDEB,IFIN
  666.         X0 = XVAL0(IA)
  667.         IF (X0 .GT. XZERO) THEN
  668.           XVAL2(IA)= BESSEL_Y1(XVAL0(IA))
  669.         ELSE
  670.           IRETOU = 21
  671.           RETURN
  672.         ENDIF
  673.  2701 CONTINUE
  674.       RETURN
  675.  
  676. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  677. C                                 FRESNEL CX
  678. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  679.  28   CONTINUE
  680.       DO 2801 IA = IDEB,IFIN
  681. C        XVAL2(IA)= SIGN(UN,XVAL0(IA))
  682.  2801 CONTINUE
  683.       RETURN
  684.  
  685. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  686. C                                 FRESNEL SX
  687. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  688.  29   CONTINUE
  689.       DO 2901 IA = IDEB,IFIN
  690. C        XVAL2(IA)= SIGN(UN,XVAL0(IA))
  691.  2901 CONTINUE
  692.       RETURN
  693.  
  694. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  695. C                                 GAMMA d'Euler (Fortran 2008)
  696. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  697.  30   CONTINUE
  698.       DO 3001 IA = IDEB,IFIN
  699.         X0 = XVAL0(IA)
  700.  
  701. C       X0 ne peut pas etre egal a ZERO ni un entier negatif
  702.         I0 = NINT(X0)
  703.         XI0= REAL(I0)
  704.  
  705.         IF(A_EGALE_B(XZERO,X0) .OR.
  706.      &     ((I0 .LT. 0) .AND. A_EGALE_B(X0,XI0)))THEN
  707.           IRETOU = 21
  708.           RETURN
  709.         ELSE
  710.           XVAL2(IA) = GAMMA(X0)
  711.         ENDIF
  712.  3001 CONTINUE
  713.       RETURN
  714.  
  715. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  716. C                                 BESSEL JN (Fortran 2008)
  717. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  718.  31   CONTINUE
  719.       DO 3101 IA = IDEB,IFIN
  720.         XVAL2(IA)= BESSEL_JN(I1I,XVAL0(IA))
  721.  3101 CONTINUE
  722.       RETURN
  723.  
  724. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  725. C                                 BESSEL YN (Fortran 2008)
  726. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  727.  32   CONTINUE
  728.       DO 3201 IA = IDEB,IFIN
  729.         X0 = XVAL0(IA)
  730.         IF (X0 .GT. XZERO) THEN
  731.           XVAL2(IA)= BESSEL_YN(I1I,X0)
  732.         ELSE
  733.           IRETOU = 21
  734.           RETURN
  735.         ENDIF
  736.  3201 CONTINUE
  737.       RETURN
  738.  
  739.  
  740.  
  741.  
  742. C======================================================================C
  743. C               OPERATIONS TERMES A TERMES DE 2 TABLEAUX
  744. C======================================================================C
  745.  5000 CONTINUE
  746.       IF    (NN0 .GT. NN1)THEN
  747.         NSAUT1 = NN0/NN1
  748.         NSAUT2 = 0
  749.       ELSEIF(NN1 .GT. NN0)THEN
  750.         NSAUT1 = 0
  751.         NSAUT2 = NN1/NN0
  752.       ELSE
  753.         NSAUT1 = 1
  754.         NSAUT2 = 1
  755.       ENDIF
  756.       GOTO ( 5001,5002,5003,5004,5005,9999,9999,9999,9999,9999,5011 ),
  757.      &       IOPERA
  758. C     Erreur si l''operation demandee n''est pas dans la liste
  759.  9999 CONTINUE
  760.       IRETOU = 21
  761.       RETURN
  762.  
  763. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  764. C                                   PUISSANCE
  765. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  766.  5001 CONTINUE
  767.       IF    (NN0 .EQ. NN1 ) THEN
  768. C       OPERATION TERME A TERME
  769.         DO 5101 IA = IDEB,IFIN
  770.           XFLO  = XVAL0(IA)
  771.           X2    = XVAL1(IA)
  772.           IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  773.      &        (XFLO .LT. REAL(0.D0))) THEN
  774.             IRETOU = 213
  775.             RETURN
  776.           ELSE
  777.             I2     = NINT(X2)
  778.             XFLOT1 = ABS (X2 - REAL(I2))
  779.             XFLOT  = ABS (X2 - REAL(0.5D0))
  780.             IF     ( XFLOT1 .LE. XZPREC*ABS(X2)) THEN
  781. C             PUISSANCE ENTIERE
  782.               XVAL2(IA)= XFLO ** I2
  783.             ELSEIF (XFLOT .LE. XZPREC*ABS(X2)  ) THEN
  784. C             RACINE CARREE SQRT
  785.               XVAL2(IA)= SQRT(XFLO)
  786.             ELSE
  787. C             CAS GENERAL
  788.               XVAL2(IA)= XFLO ** X2
  789.             ENDIF
  790.           ENDIF
  791.  5101   CONTINUE
  792.  
  793.       ELSEIF(NN0 .GT. NN1) THEN
  794. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  795.         DO 5201 IA = IDEB,IFIN
  796.           IB = (IA-1) / NSAUT1 + 1
  797.           XFLO  = XVAL0(IB)
  798.           X2   = XVAL1(IA)
  799.           IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  800.      &        (XFLO .LT. REAL(0.D0))) THEN
  801.             IRETOU = 213
  802.             RETURN
  803.           ELSE
  804.             I2     = NINT(X2)
  805.             XFLOT1 = ABS(X2 - REAL(I2))
  806.             XFLOT  = ABS(X2 - REAL(0.5D0))
  807.             IF     ( XFLOT1 .LE. XZPREC*ABS(X2)) THEN
  808. C             PUISSANCE ENTIERE
  809.               XVAL2(IA)= XFLO ** I2
  810.             ELSEIF (XFLOT .LE. XZPREC*ABS(X2)  ) THEN
  811. C             RACINE CARREE SQRT
  812.               XVAL2(IA)= SQRT(XFLO)
  813.             ELSE
  814. C             CAS GENERAL
  815.               XVAL2(IA)= XFLO ** X2
  816.             ENDIF
  817.           ENDIF
  818.  5201   CONTINUE
  819.  
  820.       ELSE
  821. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  822.         DO 5301 IA = IDEB,IFIN
  823.           IB = (IA-1) / NSAUT2 + 1
  824.           XFLO  = XVAL0(IA)
  825.           X2   = XVAL1(IB)
  826.           IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  827.      &        (XFLO .LT. REAL(0.D0))) THEN
  828.             IRETOU = 213
  829.             RETURN
  830.           ELSE
  831.             I2     = NINT(X2)
  832.             XFLOT1 = ABS(X2 - REAL(I2))
  833.             XFLOT  = ABS(X2 - REAL(0.5D0))
  834.             IF     ( XFLOT1 .LE. XZPREC*ABS(X2)) THEN
  835. C             PUISSANCE ENTIERE
  836.               XVAL2(IA)= XFLO ** I2
  837.             ELSEIF (XFLOT .LE. XZPREC*ABS(X2)  ) THEN
  838. C             RACINE CARREE SQRT
  839.               XVAL2(IA)= SQRT(XFLO)
  840.             ELSE
  841. C             CAS GENERAL
  842.               XVAL2(IA)= XFLO ** X2
  843.             ENDIF
  844.           ENDIF
  845.  5301   CONTINUE
  846.       ENDIF
  847.       RETURN
  848.  
  849. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  850. C                                   PRODUIT
  851. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  852.  5002 CONTINUE
  853.       IF    (NSAUT1 .EQ. 1 ) THEN
  854. C       OPERATION TERME A TERME
  855.         DO 5102 IA = IDEB,IFIN
  856.           XVAL2(IA)= XVAL0(IA) * XVAL1(IA)
  857.  5102   CONTINUE
  858.       ELSEIF(NSAUT1 .GT. 0 ) THEN
  859. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  860.         DO 5202 IA = IDEB,IFIN
  861.           IB = (IA-1) / NSAUT1 + 1
  862.           XVAL2(IA)= XVAL0(IA) * XVAL1(IB)
  863.  5202   CONTINUE
  864.       ELSE
  865. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  866.         DO 5302 IA = IDEB,IFIN
  867.           IB = (IA-1) / NSAUT2 + 1
  868.           XVAL2(IA)= XVAL0(IB) * XVAL1(IA)
  869.  5302   CONTINUE
  870.       ENDIF
  871.       RETURN
  872.  
  873. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  874. C                                  ADDITION
  875. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  876.  5003 CONTINUE
  877.       IF    (NSAUT1 .EQ. 1 ) THEN
  878. C       OPERATION TERME A TERME
  879.         DO 5103 IA=IDEB,IFIN
  880.           XVAL2(IA) = XVAL0(IA) + XVAL1(IA)
  881.  5103   CONTINUE
  882.       ELSEIF(NSAUT1 .GT. 0 ) THEN
  883. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  884.         DO 5203 IA=IDEB,IFIN
  885.           IB = (IA-1) / NSAUT1 + 1
  886.           XVAL2(IA) = XVAL0(IA) + XVAL1(IB)
  887.  5203   CONTINUE
  888.       ELSE
  889. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  890.         DO 5303 IA=IDEB,IFIN
  891.           IB = (IA-1) / NSAUT2 + 1
  892.           XVAL2(IA) = XVAL0(IB) + XVAL1(IA)
  893.  5303   CONTINUE
  894.       ENDIF
  895.       RETURN
  896.  
  897. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  898. C                                 SOUSTRACTION
  899. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  900.  5004 CONTINUE
  901.       IF    (NSAUT1 .EQ. 1 ) THEN
  902. C       OPERATION TERME A TERME
  903.         DO 5104 IA = IDEB,IFIN
  904.           XVAL2(IA)= XVAL0(IA) - XVAL1(IA)
  905.  5104   CONTINUE
  906.       ELSEIF(NSAUT1 .GT. 0 ) THEN
  907. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  908.         DO 5204 IA = IDEB,IFIN
  909.           IB = (IA-1) / NSAUT1 + 1
  910.           XVAL2(IA)= XVAL0(IA) - XVAL1(IB)
  911.  5204   CONTINUE
  912.       ELSE
  913. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  914.         DO 5304 IA = IDEB,IFIN
  915.           IB = (IA-1) / NSAUT2 + 1
  916.           XVAL2(IA)= XVAL0(IB) - XVAL1(IA)
  917.  5304   CONTINUE
  918.       ENDIF
  919.       RETURN
  920.  
  921. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  922. C                                 DIVISION
  923. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  924.  5005 CONTINUE
  925.       IF    (NSAUT1 .EQ. 1 ) THEN
  926. C       OPERATION TERME A TERME
  927.         DO 5105 IA = IDEB,IFIN
  928.           X2 = XVAL1(IA)
  929.           IF (ABS(X2) .GT. XPETIT) THEN
  930.             XVAL2(IA)= XVAL0(IA) / X2
  931.           ELSE
  932.             IRETOU = 835
  933.             RETURN
  934.           ENDIF
  935.  5105   CONTINUE
  936.       ELSEIF(NSAUT1 .GT. 0 ) THEN
  937. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  938.         DO 5205 IA = IDEB,IFIN
  939.           IB = (IA-1) / NSAUT1 + 1
  940.           X2 = XVAL1(IB)
  941.           IF (ABS(X2) .GT. XPETIT) THEN
  942.             XVAL2(IA)= XVAL0(IA) / X2
  943.           ELSE
  944.             IRETOU = 835
  945.             RETURN
  946.           ENDIF
  947.  5205   CONTINUE
  948.       ELSE
  949. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  950.         DO 5305 IA = IDEB,IFIN
  951.           IB = (IA-1) / NSAUT2 + 1
  952.           X2 = XVAL1(IA)
  953.           IF (ABS(X2) .GT. XPETIT) THEN
  954.             XVAL2(IA)= XVAL0(IB) / X2
  955.           ELSE
  956.             IRETOU = 835
  957.             RETURN
  958.           ENDIF
  959.  5305   CONTINUE
  960.       ENDIF
  961.       RETURN
  962.  
  963. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  964. C                    ARCTANGENTE A 2 ARGUMENTS
  965. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  966.  5011 CONTINUE
  967.       IF    (NSAUT1 .EQ. 1 ) THEN
  968. C       OPERATION TERME A TERME
  969.         DO 5111 IA = IDEB,IFIN
  970.           XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IA))
  971.  5111   CONTINUE
  972.       ELSEIF(NSAUT1 .GT. 0 ) THEN
  973. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  974.         DO 5211 IA = IDEB,IFIN
  975.           IB = (IA-1) / NSAUT1 + 1
  976.           XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IB))
  977.  5211   CONTINUE
  978.       ELSE
  979. C       OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  980.         DO 5311 IA = IDEB,IFIN
  981.           IB = (IA-1) / NSAUT2 + 1
  982.           XVAL2(IA)= XINV * ATAN2(XVAL0(IB),XVAL1(IA))
  983.  5311   CONTINUE
  984.       ENDIF
  985.       RETURN
  986.  
  987.       END
  988.  
  989.  
  990.  
  991.  
  992.  

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