Télécharger opflot.eso

Retour à la liste

Numérotation des lignes :

  1. C OPFLOT SOURCE CB215821 18/06/07 09:10:09 9835
  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. -INC CCOPTIO
  54. -INC CCREEL
  55. C
  56.  
  57. XOUT=XZERO
  58. C
  59. GOTO(1 ,2 ,3 ,4 ,5 ,6 ,7 ,8 ,9 ,10,11,12,13,14,15,
  60. & 16,17,18,19,20,21,22),(IOPERA-5)
  61. C
  62. C COSINUS
  63. 1 CONTINUE
  64. XCONV = XPI / 180.
  65. XOUT=COS(XCONV*XIN1)
  66. GOTO 166
  67. C
  68. C SINUS
  69. 2 CONTINUE
  70. XCONV = XPI / 180.
  71. XOUT=SIN(XCONV*XIN1)
  72. GOTO 166
  73. C
  74. C TANGENTE
  75. 3 CONTINUE
  76. XCONV = XPI / 180.
  77. XOUT=TAN(XCONV*XIN1)
  78. GOTO 166
  79. C
  80. C ARCOSINUS
  81. 4 CONTINUE
  82. XVNOC = 180. / XPI
  83. IF ( (XIN1 .GE. -1.) .AND. (XIN1 .LE. 1.)) THEN
  84. XOUT=XVNOC*ACOS(XIN1)
  85. ELSE
  86. GOTO 165
  87. ENDIF
  88. GOTO 166
  89. C
  90. C ARCSINUS
  91. 5 CONTINUE
  92. XVNOC = 180. / XPI
  93. IF ( (XIN1 .GE. -1.) .AND. (XIN1 .LE. 1.)) THEN
  94. XOUT=XVNOC*ASIN(XIN1)
  95. ELSE
  96. GOTO 165
  97. ENDIF
  98. GOTO 166
  99. C
  100. C ARCTANGENTE
  101. 6 CONTINUE
  102. XVNOC = 180. / XPI
  103. IF (BATAN2 .EQV. .TRUE.) THEN
  104. IF ( XIN2 .EQ. 0. ) THEN
  105. IF ( XIN1 .GT. 0. ) THEN
  106. XOUT = 90.
  107. ELSEIF ( XIN1 .LT. 0. ) THEN
  108. XOUT = -90.
  109. ELSE
  110. REAERR(1)=XIN1
  111. CALL ERREUR(1009)
  112. ENDIF
  113. ELSE
  114. XOUT=XVNOC*ATAN2(XIN1,XIN2)
  115. ENDIF
  116. ELSE
  117. XOUT=XVNOC*ATAN(XIN1)
  118. ENDIF
  119. GOTO 166
  120. C
  121. C EXPONENTIELLE
  122. 7 CONTINUE
  123. XOUT=EXP(XIN1)
  124. GOTO 166
  125. C
  126. C LOGARITHME
  127. 8 CONTINUE
  128. IF ( XIN1 .GE. XPETIT) THEN
  129. XOUT=LOG(XIN1)
  130. ELSE
  131. GOTO 165
  132. ENDIF
  133. GOTO 166
  134. C
  135. C VALEUR ABSOLUE
  136. 9 CONTINUE
  137. XOUT=ABS(XIN1)
  138. GOTO 166
  139. C
  140. C COSINUS HYPERBOLIQUE
  141. 10 CONTINUE
  142. XOUT=COSH(XIN1)
  143. GOTO 166
  144. C
  145. C SINUS HYPERBOLIQUE
  146. 11 CONTINUE
  147. XOUT=SINH(XIN1)
  148. GOTO 166
  149. C
  150. C TANGENTE HYPERBOLIQUE
  151. 12 CONTINUE
  152. XOUT=TANH(XIN1)
  153. GOTO 166
  154. C
  155. C FONCTION D'ERREUR ERF
  156. 13 CONTINUE
  157. XOUT=ERF(XIN1)
  158. GOTO 166
  159. C
  160. C ERFC (Complementaire de ERF --> 1-ERF(x) )
  161. 14 CONTINUE
  162. XOUT=ERFC(XIN1)
  163. GOTO 166
  164. C
  165. C ARGCH (Reciproque de COSINUS HYPERBOLIQUE)
  166. 15 CONTINUE
  167. IF ( XIN1 .GE. 1. ) THEN
  168. XOUT=LOG(XIN1 + SQRT(XIN1*XIN1-1.))
  169. ELSE
  170. GOTO 165
  171. ENDIF
  172. GOTO 166
  173. C
  174. C ARGSH (Reciproque de SINUS HYPERBOLIQUE)
  175. 16 CONTINUE
  176. XOUT=LOG(XIN1 + SQRT(XIN1*XIN1+1.))
  177. GOTO 166
  178. C
  179. C ARGTH (Reciproque de TANGENTE HYPERBOLIQUE)
  180. 17 CONTINUE
  181. IF ( (ABS(XIN1) .NE. 1.) ) THEN
  182. XOUT=0.5 * LOG((1.+XIN1)/(1.-XIN1))
  183. ELSE
  184. GOTO 165
  185. ENDIF
  186. GOTO 166
  187. C
  188. C SIGN
  189. 18 CONTINUE
  190. XOUT = SIGN(UN,XIN1)
  191. GOTO 166
  192. C
  193. C '*' (Produit de 2 FLOTTANTS)
  194. 19 CONTINUE
  195. XOUT = XIN1 * XIN2
  196. GOTO 166
  197. C
  198. C '/' (Division de 2 FLOTTANTS)
  199. 20 CONTINUE
  200. XOUT = XIN1 / XIN2
  201. GOTO 166
  202. C
  203. C '**' (Puissance de 2 FLOTTANTS)
  204. 21 CONTINUE
  205. XOUT = XIN1 ** XIN2
  206. GOTO 166
  207. C
  208. C '**' (Puissance de FLOTTANT ** ENTIER)
  209. 22 CONTINUE
  210. XOUT = XIN1 ** IIN1
  211. GOTO 166
  212.  
  213.  
  214. C Arrivee ici en cas d'erreur sur le domaine de validite de l'operation
  215. 165 CONTINUE
  216. REAERR(1)=XIN1
  217. CALL ERREUR(1009)
  218. RETURN
  219.  
  220. C Arrivee ici apres avoir effectue l'operation
  221. 166 CONTINUE
  222. C Verification que le resultat obtenu est bien un nombre (Pas Nan ni Inf)
  223. IF (.NOT. (ABS(XOUT) .LE. XGRAND)) THEN
  224. REAERR(1)=XIN1
  225. CALL ERREUR(1009)
  226. ENDIF
  227. RETURN
  228. END
  229.  
  230.  

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