Télécharger opflot.eso

Retour à la liste

Numérotation des lignes :

  1. C OPFLOT SOURCE GOUNAND 19/07/23 21:15:16 10267
  2. SUBROUTINE OPFLOT(XIN1,XIN2,IIN1,BATAN2,IOPERA,XOUT)
  3. C=======================================================================
  4. C EFFECTUE DIVERSES OPERATIONS SUR LES FLOTTANTS
  5. C=======================================================================
  6. C ENTREES
  7. C XIN1= FLOTTANT sur lequel on effectue l'operation
  8. C XIN2= deuxieme argument FLOTTANT pour l'operation ATAN2
  9. C IIN1= troisieme argument ENTIER pour l'operation FLOTTANT ** ENTIER
  10. C BATAN2= TRUE Booleen permettant de faire l'operation ATAN2
  11. C = FALSE Booleen permettant de faire l'operation ATAN
  12. C IOPERA= 1 COSINUS
  13. C = 2 SINUS
  14. C = 3 TANGENTE
  15. C = 4 ARCOSINUS
  16. C = 5 ARCSINUS
  17. C = 6 ARCTANGENTE
  18. C = 7 EXPONENTIELLE
  19. C = 8 LOGARITHME
  20. C = 9 VALEUR ABSOLUE
  21. C = 10 COSINUS HYPERBOLIQUE
  22. C = 11 SINUS HYPERBOLIQUE
  23. C = 12 TANGENTE HYPERBOLIQUE
  24. C = 13 ERF FONCTION D'ERRREUR DE GAUSS
  25. C = 14 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
  26. C = 15 ARGCH (Fonction reciproque de COSH)
  27. C = 16 ARGSH (Fonction reciproque de SINH)
  28. C = 17 ARGTH (Fonction reciproque de TANH)
  29. C = 18 SIGN(1.D0,XIN1)
  30. C
  31. C = 19 PRODUIT XIN1 * XIN2
  32. C = 20 DIVISION XIN1 / XIN2
  33. C = 21 PUISSANCE XIN1 ** XIN2
  34. C = 22 PUISSANCE XIN1 ** IIN1
  35. C
  36. C SORTIES
  37. C XOUT=FLOTTANT RESULTAT
  38. C
  39. C HISTORIQUE :
  40. C - CB215821 2014 --> Creation
  41. C - CB215821 05/06/2018 --> Ajout de la fonction SIGN a un argument
  42. C
  43. C=======================================================================
  44.  
  45. IMPLICIT INTEGER(I-N)
  46. IMPLICIT REAL*8(A-H,O-Z)
  47.  
  48. LOGICAL BATAN2
  49. INTEGER IOPERA,IIN1
  50. REAL*8 XIN1,XIN2,XOUT,XCONV,XVNOC
  51. PARAMETER (UN = 1.D0)
  52.  
  53.  
  54. -INC PPARAM
  55. -INC CCOPTIO
  56. -INC CCREEL
  57. C
  58.  
  59. XOUT=XZERO
  60. C
  61. GOTO(1 ,2 ,3 ,4 ,5 ,6 ,7 ,8 ,9 ,10,11,12,13,14,15,
  62. & 16,17,18,19,20,21,22),(IOPERA-5)
  63. C
  64. C COSINUS
  65. 1 CONTINUE
  66. XCONV = XPI / 180.D0
  67. XOUT=COS(XCONV*XIN1)
  68. GOTO 166
  69. C
  70. C SINUS
  71. 2 CONTINUE
  72. XCONV = XPI / 180.D0
  73. XOUT=SIN(XCONV*XIN1)
  74. GOTO 166
  75. C
  76. C TANGENTE
  77. 3 CONTINUE
  78. XCONV = XPI / 180.D0
  79. XOUT=TAN(XCONV*XIN1)
  80. GOTO 166
  81. C
  82. C ARCOSINUS
  83. 4 CONTINUE
  84. XVNOC = 180.D0 / XPI
  85. IF ( (XIN1 .GE. -1.D0) .AND. (XIN1 .LE. 1.D0)) THEN
  86. XOUT=XVNOC*ACOS(XIN1)
  87. ELSE
  88. GOTO 165
  89. ENDIF
  90. GOTO 166
  91. C
  92. C ARCSINUS
  93. 5 CONTINUE
  94. XVNOC = 180.D0 / XPI
  95. IF ( (XIN1 .GE. -1.D0) .AND. (XIN1 .LE. 1.D0)) THEN
  96. XOUT=XVNOC*ASIN(XIN1)
  97. ELSE
  98. GOTO 165
  99. ENDIF
  100. GOTO 166
  101. C
  102. C ARCTANGENTE
  103. 6 CONTINUE
  104. XVNOC = 180.D0 / XPI
  105. IF (BATAN2 .EQV. .TRUE.) THEN
  106. IF ( XIN2 .EQ. 0.D0 ) THEN
  107. IF ( XIN1 .GT. 0.D0 ) THEN
  108. XOUT = 90.D0
  109. ELSEIF ( XIN1 .LT. 0.D0 ) THEN
  110. XOUT = -90.D0
  111. ELSE
  112. REAERR(1)=XIN1
  113. CALL ERREUR(1009)
  114. ENDIF
  115. ELSE
  116. XOUT=XVNOC*ATAN2(XIN1,XIN2)
  117. ENDIF
  118. ELSE
  119. XOUT=XVNOC*ATAN(XIN1)
  120. ENDIF
  121. GOTO 166
  122. C
  123. C EXPONENTIELLE
  124. 7 CONTINUE
  125. XOUT=EXP(XIN1)
  126. GOTO 166
  127. C
  128. C LOGARITHME
  129. 8 CONTINUE
  130. IF ( XIN1 .GE. XPETIT) THEN
  131. XOUT=LOG(XIN1)
  132. ELSE
  133. GOTO 165
  134. ENDIF
  135. GOTO 166
  136. C
  137. C VALEUR ABSOLUE
  138. 9 CONTINUE
  139. XOUT=ABS(XIN1)
  140. GOTO 166
  141. C
  142. C COSINUS HYPERBOLIQUE
  143. 10 CONTINUE
  144. XOUT=COSH(XIN1)
  145. GOTO 166
  146. C
  147. C SINUS HYPERBOLIQUE
  148. 11 CONTINUE
  149. XOUT=SINH(XIN1)
  150. GOTO 166
  151. C
  152. C TANGENTE HYPERBOLIQUE
  153. 12 CONTINUE
  154. XOUT=TANH(XIN1)
  155. GOTO 166
  156. C
  157. C FONCTION D'ERREUR ERF
  158. 13 CONTINUE
  159. XOUT=ERF(XIN1)
  160. GOTO 166
  161. C
  162. C ERFC (Complementaire de ERF --> 1-ERF(x) )
  163. 14 CONTINUE
  164. XOUT=ERFC(XIN1)
  165. GOTO 166
  166. C
  167. C ARGCH (Reciproque de COSINUS HYPERBOLIQUE)
  168. 15 CONTINUE
  169. IF ( XIN1 .GE. 1.D0 ) THEN
  170. XOUT=LOG(XIN1 + SQRT(XIN1*XIN1-1.D0))
  171. ELSE
  172. GOTO 165
  173. ENDIF
  174. GOTO 166
  175. C
  176. C ARGSH (Reciproque de SINUS HYPERBOLIQUE)
  177. 16 CONTINUE
  178. XOUT=LOG(XIN1 + SQRT(XIN1*XIN1+1.D0))
  179. GOTO 166
  180. C
  181. C ARGTH (Reciproque de TANGENTE HYPERBOLIQUE)
  182. 17 CONTINUE
  183. IF ( (ABS(XIN1) .NE. 1.D0) ) THEN
  184. XOUT=0.5D0 * LOG((1.D0+XIN1)/(1.D0-XIN1))
  185. ELSE
  186. GOTO 165
  187. ENDIF
  188. GOTO 166
  189. C
  190. C SIGN
  191. 18 CONTINUE
  192. XOUT = SIGN(UN,XIN1)
  193. GOTO 166
  194. C
  195. C '*' (Produit de 2 FLOTTANTS)
  196. 19 CONTINUE
  197. XOUT = XIN1 * XIN2
  198. GOTO 166
  199. C
  200. C '/' (Division de 2 FLOTTANTS)
  201. 20 CONTINUE
  202. XOUT = XIN1 / XIN2
  203. GOTO 166
  204. C
  205. C '**' (Puissance de 2 FLOTTANTS)
  206. 21 CONTINUE
  207. XOUT = XIN1 ** XIN2
  208. GOTO 166
  209. C
  210. C '**' (Puissance de FLOTTANT ** ENTIER)
  211. 22 CONTINUE
  212. XOUT = XIN1 ** IIN1
  213. GOTO 166
  214.  
  215.  
  216. C Arrivee ici en cas d'erreur sur le domaine de validite de l'operation
  217. 165 CONTINUE
  218. REAERR(1)=XIN1
  219. CALL ERREUR(1009)
  220. RETURN
  221.  
  222. C Arrivee ici apres avoir effectue l'operation
  223. 166 CONTINUE
  224. C Verification que le resultat obtenu est bien un nombre (Pas Nan ni Inf)
  225. IF (.NOT. (ABS(XOUT) .LE. XGRAND)) THEN
  226. REAERR(1)=XIN1
  227. CALL ERREUR(1009)
  228. ENDIF
  229. RETURN
  230. END
  231.  
  232.  
  233.  
  234.  
  235.  

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