Télécharger openti.eso

Retour à la liste

Numérotation des lignes :

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

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