Télécharger opflot.eso

Retour à la liste

Numérotation des lignes :

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

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