Télécharger oplent.eso

Retour à la liste

Numérotation des lignes :

  1. C OPLENT SOURCE CB215821 16/09/05 21:15:03 9061
  2. SUBROUTINE OPLENT(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 E N T
  8. C -----------
  9. C
  10. C FONCTION:
  11. C ---------
  12. C
  13. C EFFECTUE DIVERSES OPERATIONS SUR UN LISTENTI.
  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 LISTENTI.
  23. C IPO3 (E) POINTEUR SUR UN LISTENTI si appel à ATAN2
  24.  
  25. C ENTREE
  26. C IEPS = 1 PUISSANCE
  27. C = 2 PRODUIT
  28. C = 3 ADDITION
  29. C = 4 SOUSTRACTION
  30. C = 5 DIVISION
  31. C = 6 COSINUS
  32. C = 7 SINUS
  33. C = 8 TANGENTE
  34. C = 9 ARCOSINUS
  35. C = 10 ARCSINUS
  36. C = 11 ARCTANGENTE
  37. C = 12 EXPONENTIELLE
  38. C = 13 LOGARITHME
  39. C = 14 VALEUR ABSOLUE
  40. C = 15 COSINUS HYPERBOLIQUE
  41. C = 16 SINUS HYPERBOLIQUE
  42. C = 17 TANGENTE HYPERBOLIQUE
  43. C = 18 ERF FONCTION D'ERRREUR DE GAUSS
  44. C = 19 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
  45. C = 20 ARGCH (Fonction reciproque de COSH)
  46. C = 21 ARGSH (Fonction reciproque de SINH)
  47. C = 22 ARGTH (Fonction reciproque de TANH)
  48. C
  49. C IPO3 (S) POINTEUR SUR LE LISTREEL RESULTAT.
  50. C = 0 , SI OPERATION IMPOSSIBLE.
  51. C
  52. C AUTEUR, DATE DE CREATION:
  53. C -------------------------
  54. C
  55. C LIONEL VIVAN 12/04/88 CREATION
  56. C P. MANIGOT 05/09/88 AJOUT DE "EXP" ET "LOG".
  57. C L. VIVAN 18/07/90 AJOUT DE "SIN" ET "COS".
  58. C C. BERTHINIER 24/07/14 REMANIEMENT ET APPEL A OPFLOT QUI FAIT LE
  59. C TRAVAIL EN TESTANT LA VALIDITE LES NOMBRES
  60. C C. BERTHINIER 05/09/16 CORRECTION POUR LE CAS 'ABS'
  61. C
  62. C LANGAGE:
  63. C --------
  64. C
  65. C ESOPE + FORTRAN77
  66. C
  67. C***********************************************************************
  68. C
  69. LOGICAL BATAN2
  70. REAL*8 XIN1,XIN2,XOUT
  71. INTEGER I,LDIM1,LDIM2,IR1,IR2,IPO1,IPO2,IR
  72.  
  73. C-INC CCOPTIO
  74. C-INC CCREEL
  75. -INC SMLREEL
  76. -INC SMLENTI
  77.  
  78. BATAN2 = .FALSE.
  79.  
  80. IR =0
  81. IR1 =0
  82. IR2 =0
  83. LDIM1=0
  84. LDIM2=0
  85.  
  86. XIN1 = 0.D0
  87. XIN2 = 0.D0
  88.  
  89. MLENTI = IPO1
  90. SEGACT MLENTI
  91. LDIM1 = MLENTI.LECT(/1)
  92.  
  93. IF ( IPO3 .NE. 0 ) THEN
  94. MLENT2 = IPO3
  95. SEGACT MLENT2
  96. LDIM2 = MLENT2.LECT(/1)
  97.  
  98. C Les deux objets doivent être de même taille
  99. IF (LDIM1 .NE. LDIM2 ) THEN
  100. SEGDES,MLENT2,MLENTI
  101. CALL ERREUR(217)
  102. RETURN
  103. ENDIF
  104.  
  105. BATAN2 = .TRUE.
  106. ENDIF
  107.  
  108. JG = LDIM1
  109.  
  110. C Resultat LISTENTI attendu pour ABS (IEPS = 14)
  111. IF (IEPS .EQ. 14) THEN
  112. SEGINI MLENT1
  113. IPO2 = MLENT1
  114. ELSE
  115. SEGINI MLREE1
  116. IPO2 = MLREE1
  117. ENDIF
  118.  
  119.  
  120. DO 10 I = 1,LDIM1
  121. C Resultat LISTENTI attendu pour ABS (IEPS = 14)
  122. IF (IEPS .EQ. 14) THEN
  123. IR1 = MLENTI.LECT(I)
  124. CALL OPENTI(IR1,IR2,BATAN2,IEPS,IOUT,XOUT)
  125. MLENT1.LECT(I) = IOUT
  126. ELSE
  127. XIN1 = DBLE(MLENTI.LECT(I))
  128. IF ( BATAN2 .EQV. .TRUE. ) THEN
  129. XIN2 = DBLE(MLENT2.LECT(I))
  130. ENDIF
  131. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  132. MLREE1.PROG(I) = XOUT
  133. ENDIF
  134. 10 CONTINUE
  135. C
  136. SEGDES,MLENTI
  137. C Resultat LISTENTI attendu pour ABS (IEPS = 14)
  138. IF (IEPS .EQ. 14) THEN
  139. SEGDES,MLENT1
  140. ELSE
  141. SEGDES,MLREE1
  142. ENDIF
  143.  
  144. IF ( BATAN2 .EQV. .TRUE. ) THEN
  145. SEGDES,MLENT2
  146. ENDIF
  147.  
  148. IPO3 = IPO2
  149. C
  150. RETURN
  151.  
  152. END
  153.  
  154.  
  155.  
  156.  
  157.  

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