Télécharger openti.eso

Retour à la liste

Numérotation des lignes :

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

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