Télécharger oplree.eso

Retour à la liste

Numérotation des lignes :

  1. C OPLREE SOURCE CB215821 15/02/27 21:15:10 8417
  2. SUBROUTINE OPLREE(IPO1,IEPS,IPO3)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C O P L R E E
  8. C -----------
  9. C
  10. C FONCTION:
  11. C ---------
  12. C
  13. C EFFECTUE DIVERSES OPERATIONS SUR UN LISTREEL.
  14. C
  15. C MODULES UTILISES:
  16. C -----------------
  17. C
  18. C
  19. C PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  20. C -----------
  21. C
  22. C IPO1 (E) POINTEUR SUR UN LISTREEL.
  23. C IPO3 (E) POINTEUR SUR UN LISTREEL si appel à ATAN2.
  24. C IEPS = 1 COSINUS
  25. C = 2 SINUS
  26. C = 3 TANGENTE
  27. C = 4 ARCOSINUS
  28. C = 5 ARCSINUS
  29. C = 6 ARCTANGENTE
  30. C = 7 EXPONENTIELLE
  31. C = 8 LOGARITHME
  32. C = 9 VALEUR ABSOLUE
  33. C =10 COSINUS HYPERBOLIQUE
  34. C =11 SINUS HYPERBOLIQUE
  35. C =12 TANGENTE HYPERBOLIQUE
  36. C =13 ERF FONCTION D'ERRREUR DE GAUSS
  37. C =14 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
  38. C =15 ARGCH (Fonction reciproque de COSH)
  39. C =16 ARGSH (Fonction reciproque de SINH)
  40. C =17 ARGTH (Fonction reciproque de TANH)
  41. C =18 COTANGENTE (inverse de la tangente)
  42.  
  43. C =19 PRODUIT FLOTTANT * FLOTTANT
  44. C =20 DIVISION FLOTTANT / FLOTTANT
  45. C =21 PUISSANCE FLOTTANT ** FLOTTANT
  46. C =22 PUISSANCE FLOTTANT ** ENTIER
  47. C
  48. C IPO3 (S) POINTEUR SUR LE LISTREEL RESULTAT.
  49. C
  50. C AUTEUR, DATE DE CREATION:
  51. C -------------------------
  52. C
  53. C LIONEL VIVAN 12/04/88 CREATION
  54. C P. MANIGOT 05/09/88 AJOUT DE "EXP" ET "LOG".
  55. C L. VIVAN 18/07/90 AJOUT DE "SIN" ET "COS".
  56. C C. BERTHINIER 24/07/14 REMANIEMENT ET APPEL A OPFLOT QUI FAIT LE
  57. C TRAVAIL EN TESTANT LA VALIDITE LES NOMBRES
  58. C
  59. C LANGAGE:
  60. C --------
  61. C
  62. C ESOPE + FORTRAN77
  63. C
  64. C***********************************************************************
  65. C
  66. LOGICAL BATAN2
  67. REAL*8 XX,XX1,XOUT
  68. INTEGER I,LDIM1,LDIM2,IPO1,IPO2,IPO3,IR
  69.  
  70. -INC CCOPTIO
  71. C-INC CCREEL
  72. -INC SMLREEL
  73.  
  74.  
  75. BATAN2 = .FALSE.
  76.  
  77. LDIM1 =0
  78. LDIM2 =0
  79. IPO2 =0
  80. IR =0
  81.  
  82. XX = 0.D0
  83. XX1 = 0.D0
  84.  
  85. MLREEL = IPO1
  86. SEGACT MLREEL
  87. LDIM1 = MLREEL.PROG(/1)
  88.  
  89. IF ( IPO3 .NE. 0 ) THEN
  90. MLREE2 = IPO3
  91. SEGACT MLREE2
  92. LDIM2 = MLREE2.PROG(/1)
  93.  
  94. C Les deux objets doivent être de même taille
  95. IF (LDIM1 .NE. LDIM2 ) THEN
  96. SEGDES,MLREE2,MLREEL
  97. CALL ERREUR(217)
  98. RETURN
  99. ENDIF
  100.  
  101. BATAN2 = .TRUE.
  102. ENDIF
  103.  
  104. JG = LDIM1
  105. SEGINI MLREE1
  106. IPO2 = MLREE1
  107.  
  108.  
  109. DO 10 I = 1,LDIM1
  110. XX = MLREEL.PROG(I)
  111. IF ( BATAN2 .EQV. .TRUE. ) THEN
  112. XX1 = MLREE2.PROG(I)
  113. ENDIF
  114. CALL OPFLOT(XX,XX1,IR,BATAN2,IEPS,XOUT)
  115. MLREE1.PROG(I) = XOUT
  116. 10 CONTINUE
  117. C
  118. SEGDES,MLREE1,MLREEL
  119. IF ( BATAN2 .EQV. .TRUE. ) THEN
  120. SEGDES,MLREE2
  121. ENDIF
  122.  
  123. IPO3 = IPO2
  124. C
  125. RETURN
  126.  
  127. END
  128.  
  129.  
  130.  
  131.  

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