Télécharger optabj.eso

Retour à la liste

Numérotation des lignes :

  1. C OPTABJ SOURCE CB215821 18/12/07 21:15:05 10033
  2. SUBROUTINE OPTABj(NBTHR ,ITHR,IOPE,NTABEN,
  3. & XVAL0,XVAL1,XVAL2,
  4. & NN0 ,NN1 ,NN2 ,IARG ,I1I ,X1I ,IRETOU)
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C Cette subroutine effectue des operations elementaires ainsi que
  7. C les fonctions sur des tableaux FORTRAN de REAL*8
  8. C Elle est prevue pour etre executee en parallele
  9. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. C NBTHR : Nombre de Thread disponibles
  11. C ITHR : Numero du Thread courant
  12. C IRETOU : Entier contenant le code d'erreur
  13. C IOPE : Type d''operation a realiser (Voir ci-dessous)
  14. C NTABEN : Nombre de tableaux constituant l''entree (Exemple : 2 pour ATAN2)
  15. C XVAL0 : Tableau de valeur d''entree
  16. C XVAL1 : Tableau de valeur d''entree (Deuxieme argument pour ATAN2)
  17. C XVAL2 : Tableau de valeur de sortie
  18. C NN0 : Taille du tableau XVAL0
  19. C NN1 : Taille du tableau XVAL1
  20. C NN2 : Taille du tableau XVAL2
  21. C
  22. C IARG = 0 ==> ARGUMENT I1I ET X1I INUTILISES
  23. C IARG = 1 ==> ARGUMENT I1I UTILISE
  24. C IARG = 11 ==> ARGUMENT I1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (PUISSANCE, SOUSTRACTION, DIVISION : POSITIONNEL)
  25. C IARG = 2 ==> ARGUMENT X1I UTILISE
  26. C IARG = 21 ==> ARGUMENT X1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (PUISSANCE, SOUSTRACTION, DIVISION : POSITIONNEL)
  27. C
  28. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  29. C
  30. C Elle realise les operations suivantes :
  31. C Operations elementaires entre un TABLEAU et un ENTIER ou FLOTTANT
  32. C IOPE = 1 PUISSANCE
  33. C = 2 PRODUIT
  34. C = 3 ADDITION
  35. C = 4 SOUSTRACTION
  36. C = 5 DIVISION
  37. C
  38. C Fonctions sur un TABLEAU
  39. C = 6 COSINUS
  40. C = 7 SINUS
  41. C = 8 TANGENTE
  42. C = 9 ARCOSINUS
  43. C = 10 ARCSINUS
  44. C = 11 ARCTANGENTE
  45. C = 12 EXPONENTIELLE
  46. C = 13 LOGARITHME
  47. C = 14 VALEUR ABSOLUE
  48. C = 15 COSINUS HYPERBOLIQUE
  49. C = 16 SINUS HYPERBOLIQUE
  50. C = 17 TANGENTE HYPERBOLIQUE
  51. C = 18 ERF FONCTION D''ERRREUR DE GAUSS
  52. C = 19 ERFC FONCTION D''ERRREUR COMPLEMENTAIRE DE GAUSS (1-ERF(X))
  53. C = 20 ARGCH (FONCTION RECIPROQUE DE COSH)
  54. C = 21 ARGSH (FONCTION RECIPROQUE DE SINH)
  55. C = 22 ARGTH (FONCTION RECIPROQUE DE TANH)
  56. C = 23 SIGN (renvoie -1 ou +1)
  57. C
  58. C HISTORIQUE :
  59. C - CB215821 31/08/2016 --> Creation
  60. C - CB215821 05/06/2018 --> Ajout de la fonction SIGN a un argument
  61. C
  62. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  63.  
  64. IMPLICIT INTEGER(I-N)
  65. IMPLICIT REAL*8 (A-H,O-Z)
  66.  
  67. -INC CCREEL
  68.  
  69. INTEGER NTABEN
  70.  
  71. REAL*8 XNOR,XINV,XFLOT,XFLOT1,XFLOT2,XIINV,XPREC,XTRA,X2,XF1,UN
  72. PARAMETER (XNOR = XPI / 180.D0)
  73. PARAMETER (XINV = 180.D0 / XPI)
  74. PARAMETER (UN = 1.D0)
  75.  
  76. REAL*8 XVAL0(NN0),XVAL1(NN1),XVAL2(NN2)
  77.  
  78. INTEGER IRETOU
  79.  
  80. I2 = I1I
  81. X2 = X1I
  82. IARG2 = IARG
  83. IRETOU = 0
  84.  
  85. C On assure le travail contigu en memoire
  86. NNC = MAX(NN0,NN1,NN2)
  87. IF(NBTHR .EQ. 1)THEN
  88. IDEB = 1
  89. IFIN = NNC
  90. ELSE
  91. IRES = MOD(NNC,NBTHR)
  92. IF(IRES .EQ. 0)THEN
  93. ILON = NNC / NBTHR
  94. IDEB = (ithr -1)* ILON + 1
  95. ELSE
  96. IF (ithr .LE. IRES) THEN
  97. ILON = (NNC / NBTHR) + 1
  98. IDEB = (ithr -1)* ILON + 1
  99. ELSE
  100. ILON = NNC / NBTHR
  101. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  102. ENDIF
  103. ENDIF
  104. IFIN = IDEB + ILON - 1
  105. ENDIF
  106.  
  107. IF (NTABEN .EQ. 2) GOTO 5000
  108.  
  109. C======================================================================C
  110. C OPERATIONS ENTRE UN TABLEAU ET UN FLOTTANT / ENTIER
  111. C======================================================================C
  112. C IF (IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) THEN
  113. C X2 = REAL(I1I)
  114. C ELSEIF(IARG2 .NE. 0 .AND. IARG2 .NE. 2 .AND. IARG2 .NE. 21) THEN
  115. C Surveillance de la validite des PARAMETRES d'entree
  116. C IRETOU = 21
  117. C RETURN
  118. C ENDIF
  119.  
  120. C PRINT *, 'OPTABJ',ITHR,IOPE,NN0
  121. GOTO ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,
  122. & 18,19,20,21,22,23 ),IOPE
  123.  
  124. C Erreur si l''operation demandee n''est pas dans la liste
  125. IRETOU = 21
  126. RETURN
  127.  
  128. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  129. C PUISSANCE
  130. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  131. 1 CONTINUE
  132. IF (IARG2 .EQ. 1) THEN
  133. C PRINT *,'TABLEAU ** ENTIER',ITHR
  134. IF (I2 .EQ. 0) THEN
  135. C PRINT *,' Cas TABLEAU ** 0'
  136. DO 101 IA = IDEB,IFIN
  137. XVAL2(IA)= REAL(1.D0)
  138. 101 CONTINUE
  139. RETURN
  140.  
  141. ELSEIF(I2 .EQ. 1)THEN
  142. C PRINT *,' Cas TABLEAU ** 1'
  143. DO 102 IA = IDEB,IFIN
  144. XVAL2(IA)= XVAL0(IA)
  145. 102 CONTINUE
  146. RETURN
  147.  
  148. ELSE
  149. DO 103 IA = IDEB,IFIN
  150. XTRA=XVAL0(IA)
  151. IF(ABS(XTRA).LE.XPETIT .AND. I2.LT.0)THEN
  152. IRETOU = 213
  153. RETURN
  154. ELSE
  155. XVAL2(IA)= XTRA ** I2
  156. ENDIF
  157. 103 CONTINUE
  158. RETURN
  159. ENDIF
  160. RETURN
  161.  
  162. ELSEIF(IARG2 .EQ. 2) THEN
  163. C PRINT *,'TABLEAU ** FLOTTANT',ITHR
  164. I2 = NINT(X2)
  165. XFLOT = ABS(X2 - REAL(I2))
  166. XPREC = (XZPREC*ABS(X2)*REAL(2.D0))
  167.  
  168. C Verification si puissance ENTIERE possible
  169. IF ( XFLOT .LE. XPREC) THEN
  170. IARG2=1
  171. GOTO 1
  172. ENDIF
  173.  
  174. C Verification si SQRT possible
  175. XF1 = X2 - REAL(0.5D0)
  176. I2 = NINT(XF1)
  177. I3 = (I2 * 2) + 1
  178. XFLOT = ABS(XF1 - REAL(I2))
  179. IF (XFLOT .LE. XPREC) THEN
  180. IF (I2 .EQ. 0) THEN
  181. C PRINT *,' Cas SQRT simple'
  182. DO 104 IA = IDEB,IFIN
  183. IF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  184. IRETOU = 213
  185. RETURN
  186. ELSE
  187. XVAL2(IA)= SQRT(XVAL0(IA))
  188. ENDIF
  189. 104 CONTINUE
  190. RETURN
  191.  
  192. ELSE
  193. C PRINT *,' Nouveau cas SQRT ** I3',I3
  194. DO 105 IA = IDEB,IFIN
  195. IF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  196. IRETOU = 213
  197. RETURN
  198. ELSE
  199. XVAL2(IA)= (SQRT(XVAL0(IA))) ** I3
  200. ENDIF
  201. 105 CONTINUE
  202. RETURN
  203. ENDIF
  204. RETURN
  205.  
  206. ELSE
  207. C Verification si racine Nieme possible
  208. IF (X2 .GT. XPETIT) THEN
  209. XIINV=UN/X2
  210. IINV = NINT(XIINV)
  211. XFLOT= ABS(XIINV - REAL(IINV))
  212. XPREC= XZPREC*ABS(XIINV)*REAL(2.D0)
  213.  
  214. IF (XFLOT .LE. XPREC .AND. MOD(IINV,2).NE. 0) THEN
  215. C PRINT *,' Racine Nieme'
  216. DO 106 IA = IDEB,IFIN
  217. XFLOT = XVAL0(IA)
  218. XVAL2(IA)=SIGN(UN,XFLOT)*(ABS(XFLOT)**X2)
  219. 106 CONTINUE
  220. RETURN
  221. ENDIF
  222. ENDIF
  223.  
  224. C PRINT *,' Cas general'
  225. DO 107 IA = IDEB,IFIN
  226. IF ((ABS(XVAL0(IA)) .LE. XPETIT) .AND.
  227. & (X2 .LT. REAL(0.D0))) THEN
  228. IRETOU = 213
  229. RETURN
  230. ELSEIF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  231. IRETOU = 213
  232. RETURN
  233. ELSE
  234. XVAL2(IA)= XVAL0(IA) ** X2
  235. ENDIF
  236. 107 CONTINUE
  237. RETURN
  238. ENDIF
  239. RETURN
  240.  
  241. ELSEIF(IARG2 .EQ. 11 .OR. IARG2 .EQ. 21) THEN
  242. C PRINT *,'ENTIER ** TABLEAU ou FLOTTANT ** TABLEAU'
  243. IF(IARG2 .EQ. 11) X2 = REAL(I1I)
  244. DO 108 IA = IDEB,IFIN
  245. I2 = NINT(XVAL0(IA))
  246. XFLOT1= ABS(XVAL0(IA) - REAL(I2 ))
  247. XFLOT2= ABS(XVAL0(IA) - REAL(0.5D0))
  248. XPREC = (XZPREC*ABS(XVAL0(IA))*REAL(2.D0))
  249. IF (((ABS(X2) .LE. XPETIT) .AND.
  250. & (XVAL0(IA).LT.REAL(0.D0) )) .OR.
  251. & (X2 .LT. REAL(0.D0))) THEN
  252. IRETOU = 213
  253. RETURN
  254. ELSEIF ( XFLOT1 .LE. XPREC ) THEN
  255. C PRINT *,' Puissance Entiere Possible'
  256. XVAL2(IA)= X2 ** I2
  257. ELSEIF ( XFLOT2 .LE. XPREC) THEN
  258. C PRINT *,' SQRT Possible'
  259. XVAL2(IA)= SQRT(X2)
  260. ELSE
  261. C PRINT *,' Cas general'
  262. XVAL2(IA)= X2 ** XVAL0(IA)
  263. ENDIF
  264. 108 CONTINUE
  265. RETURN
  266. ENDIF
  267. RETURN
  268.  
  269. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  270. C PRODUIT
  271. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  272. 2 CONTINUE
  273. IF(IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) THEN
  274. IF (I1I .EQ. 0) RETURN
  275. X2 = REAL(I1I)
  276. ENDIF
  277.  
  278. IF(ABS(1.D0-X2) .LE. XPETIT)THEN
  279. IF(SIGN(1.D0,X2) .LT. 0.D0)THEN
  280. DO 201 IA = IDEB,IFIN
  281. XVAL2(IA)=-XVAL0(IA)
  282. 201 CONTINUE
  283. ELSE
  284. DO 202 IA = IDEB,IFIN
  285. XVAL2(IA)= XVAL0(IA)
  286. 202 CONTINUE
  287. ENDIF
  288. ELSE
  289. DO 203 IA = IDEB,IFIN
  290. XVAL2(IA)= XVAL0(IA) * X2
  291. 203 CONTINUE
  292. ENDIF
  293. RETURN
  294.  
  295. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  296. C ADDITION
  297. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  298. 3 CONTINUE
  299. IF ((IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) .AND. (I1I .EQ. 0)) THEN
  300. C PRINT *,'ADDITION Cas 1'
  301. DO 301 IA=IDEB,IFIN
  302. XVAL2(IA) = XVAL0(IA)
  303. 301 CONTINUE
  304. RETURN
  305. ENDIF
  306.  
  307. IF(IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) X2 = REAL(I1I)
  308. C PRINT *,'ADDITION Cas 2'
  309. DO 303 IA=IDEB,IFIN
  310. XVAL2(IA) = XVAL0(IA) + X2
  311. 303 CONTINUE
  312. RETURN
  313.  
  314. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  315. C SOUSTRACTION
  316. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  317. 4 CONTINUE
  318. IF (IARG2 .EQ. 1 .AND. I1I .EQ. 0) THEN
  319. C PRINT *,'SOUSTRACTION Cas 1'
  320. DO 401 IA=IDEB,IFIN
  321. XVAL2(IA) = XVAL0(IA)
  322. 401 CONTINUE
  323. RETURN
  324. ENDIF
  325. IF (IARG2 .EQ. 11 .AND. I1I .EQ. 0) THEN
  326. C PRINT *,'SOUSTRACTION Cas 2'
  327. DO 403 IA=IDEB,IFIN
  328. XVAL2(IA) = -XVAL0(IA)
  329. 403 CONTINUE
  330. RETURN
  331. ENDIF
  332. IF (IARG2 .EQ. 1) THEN
  333. C Cas TABLEAU - I1I
  334. C PRINT *,'SOUSTRACTION Cas 3'
  335. X2 = REAL(I1I)
  336. DO 405 IA = IDEB,IFIN
  337. XVAL2(IA)= XVAL0(IA) - X2
  338. 405 CONTINUE
  339. RETURN
  340. ELSEIF(IARG2 .EQ. 2) THEN
  341. C Cas TABLEAU - X2
  342. C PRINT *,'SOUSTRACTION Cas 4'
  343. DO 406 IA = IDEB,IFIN
  344. XVAL2(IA)= XVAL0(IA) - X2
  345. 406 CONTINUE
  346. RETURN
  347. ELSEIF(IARG2 .EQ. 11) THEN
  348. C Cas I1I - TABLEAU
  349. C PRINT *,'SOUSTRACTION Cas 5'
  350. X2 = REAL(I1I)
  351. DO 407 IA = IDEB,IFIN
  352. XVAL2(IA)= X2 - XVAL0(IA)
  353. 407 CONTINUE
  354. RETURN
  355. ELSEIF(IARG2 .EQ. 21) THEN
  356. C Cas X2 - TABLEAU
  357. C PRINT *,'SOUSTRACTION Cas 6'
  358. DO 408 IA = IDEB,IFIN
  359. XVAL2(IA)= X2 - XVAL0(IA)
  360. 408 CONTINUE
  361. RETURN
  362. ENDIF
  363. RETURN
  364.  
  365. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  366. C DIVISION
  367. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  368. 5 CONTINUE
  369. IF(IARG2 .EQ. 11 .AND. I1I .EQ. 0) THEN
  370. C PRINT *,'DIVISION Cas 1'
  371. RETURN
  372. C ELSEIF(IARG2 .EQ. 21 .AND. (ABS(X2) .LE. XPETIT)) THEN
  373. CC PRINT *,'DIVISION Cas 2' XPETIT divise par qqc n'est pas forcement negligeable !!!
  374. C RETURN
  375. ENDIF
  376. IF (IARG2 .EQ. 1) THEN
  377. IF (I1I .NE. 0) THEN
  378. C PRINT *,'DIVISION Cas 3'
  379. X2 = REAL(I1I)
  380. DO 501 IA = IDEB,IFIN
  381. C Cas TABLEAU / ENTIER
  382. XVAL2(IA)= XVAL0(IA) / X2
  383. 501 CONTINUE
  384. RETURN
  385. ELSE
  386. IRETOU = 835
  387. RETURN
  388. ENDIF
  389. ELSEIF (IARG2 .EQ. 2) THEN
  390. IF (ABS(X2) .GT. XPETIT) THEN
  391. C PRINT *,'DIVISION Cas 4'
  392. X3 = 1.D0 / X2
  393. DO 502 IA = IDEB,IFIN
  394. C Cas TABLEAU / FLOTTANT
  395. XVAL2(IA)= XVAL0(IA) * X3
  396. 502 CONTINUE
  397. RETURN
  398. ELSE
  399. IRETOU = 835
  400. RETURN
  401. ENDIF
  402. ELSEIF(IARG2 .EQ. 11 .OR. IARG2 .EQ. 21) THEN
  403. C PRINT *,'DIVISION Cas 5'
  404. IF (IARG2 .EQ. 11) X2 = REAL(I1I)
  405. DO 503 IA = IDEB,IFIN
  406. C Cas FLOTTANT / TABLEAU ou ENTIER / TABLEAU (terme a terme)
  407. IF (ABS(XVAL0(IA)) .GT. XPETIT) THEN
  408. XVAL2(IA)= X2 / XVAL0(IA)
  409. ELSE
  410. IRETOU = 835
  411. RETURN
  412. ENDIF
  413. 503 CONTINUE
  414. RETURN
  415. ENDIF
  416. RETURN
  417.  
  418. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  419. C COSINUS
  420. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  421. 6 CONTINUE
  422. DO 601 IA = IDEB,IFIN
  423. XVAL2(IA)= COS(XNOR * XVAL0(IA))
  424. 601 CONTINUE
  425. RETURN
  426.  
  427. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  428. C SINUS
  429. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  430. 7 CONTINUE
  431. DO 701 IA = IDEB,IFIN
  432. XVAL2(IA)= SIN(XNOR * XVAL0(IA))
  433. 701 CONTINUE
  434. RETURN
  435.  
  436. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  437. C TANGENTE
  438. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  439. 8 CONTINUE
  440. DO 801 IA = IDEB,IFIN
  441. XVAL2(IA)= TAN(XNOR * XVAL0(IA))
  442. 801 CONTINUE
  443. RETURN
  444.  
  445. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  446. C ARCCOS
  447. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  448. 9 CONTINUE
  449. DO 901 IA = IDEB,IFIN
  450. X2 = XVAL0(IA)
  451. IF (ABS(X2) .LE. UN) THEN
  452. XVAL2(IA)= XINV * ACOS(X2)
  453. ELSE
  454. IRETOU = 21
  455. RETURN
  456. ENDIF
  457. 901 CONTINUE
  458. RETURN
  459.  
  460. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  461. C ARCSIN
  462. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  463. 10 CONTINUE
  464. DO 1001 IA = IDEB,IFIN
  465. X2 = XVAL0(IA)
  466. IF (ABS(X2) .LE. UN) THEN
  467. XVAL2(IA)= XINV * ASIN(X2)
  468. ELSE
  469. IRETOU = 21
  470. RETURN
  471. ENDIF
  472. 1001 CONTINUE
  473. RETURN
  474.  
  475. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  476. C ARCTANGENTE
  477. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  478. 11 CONTINUE
  479. DO 1101 IA = IDEB,IFIN
  480. XVAL2(IA)= XINV * ATAN(XVAL0(IA))
  481. 1101 CONTINUE
  482. RETURN
  483.  
  484. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  485. C EXPONENTIELLE
  486. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  487. 12 CONTINUE
  488. DO 1201 IA = IDEB,IFIN
  489. XVAL2(IA)= EXP(XVAL0(IA))
  490. 1201 CONTINUE
  491. RETURN
  492.  
  493. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  494. C LOGARITHME
  495. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  496. 13 CONTINUE
  497. DO 1301 IA = IDEB,IFIN
  498. X2 = XVAL0(IA)
  499. IF (X2 .GT. XPETIT) THEN
  500. XVAL2(IA)= LOG(X2)
  501. ELSE
  502. IRETOU = 21
  503. RETURN
  504. ENDIF
  505. 1301 CONTINUE
  506. RETURN
  507.  
  508. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  509. C VALEUR ABSOLUE
  510. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  511. 14 CONTINUE
  512. DO 1401 IA = IDEB,IFIN
  513. XVAL2(IA)= ABS(XVAL0(IA))
  514. 1401 CONTINUE
  515. RETURN
  516.  
  517. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  518. C COSINUS HYPERBOLIQUE
  519. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  520. 15 CONTINUE
  521. DO 1501 IA = IDEB,IFIN
  522. XVAL2(IA)= COSH(XVAL0(IA))
  523. 1501 CONTINUE
  524. RETURN
  525.  
  526. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  527. C SINUS HYPERBOLIQUE
  528. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  529. 16 CONTINUE
  530. DO 1601 IA = IDEB,IFIN
  531. XVAL2(IA)= SINH(XVAL0(IA))
  532. 1601 CONTINUE
  533. RETURN
  534.  
  535. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  536. C TANGENTE HYPERBOLIQUE
  537. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  538. 17 CONTINUE
  539. DO 1701 IA = IDEB,IFIN
  540. XVAL2(IA)= TANH(XVAL0(IA))
  541. 1701 CONTINUE
  542. RETURN
  543.  
  544. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  545. C ERF (Fonction Erreur)
  546. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  547. 18 CONTINUE
  548. DO 1801 IA = IDEB,IFIN
  549. XVAL2(IA)= ERF(XVAL0(IA))
  550. 1801 CONTINUE
  551. RETURN
  552.  
  553. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  554. C ERFC (Fonction Erreur Complementaire 1-ERF(x))
  555. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  556. 19 CONTINUE
  557. DO 1901 IA = IDEB,IFIN
  558. XVAL2(IA)= ERFC(XVAL0(IA))
  559. 1901 CONTINUE
  560. RETURN
  561.  
  562. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  563. C ARCOSH
  564. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  565. 20 CONTINUE
  566. DO 2001 IA = IDEB,IFIN
  567. X2 = XVAL0(IA)
  568. IF (X2 .GE. UN) THEN
  569. XVAL2(IA)= LOG(X2 + SQRT((X2**2) - UN))
  570. ELSE
  571. IRETOU = 21
  572. RETURN
  573. ENDIF
  574. 2001 CONTINUE
  575. RETURN
  576.  
  577. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  578. C ARSINH
  579. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  580. 21 CONTINUE
  581. DO 2101 IA = IDEB,IFIN
  582. X2 = XVAL0(IA)
  583. XVAL2(IA)= LOG(X2 + SQRT((X2**2) + UN))
  584. 2101 CONTINUE
  585. RETURN
  586.  
  587. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  588. C ARTANH
  589. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  590. 22 CONTINUE
  591. DO 2201 IA = IDEB,IFIN
  592. X2 = XVAL0(IA)
  593. IF (ABS(X2) .LT. UN) THEN
  594. XVAL2(IA)=REAL(0.5D0)*LOG((UN+X2) / (UN - X2))
  595. ELSE
  596. IRETOU = 21
  597. RETURN
  598. ENDIF
  599. 2201 CONTINUE
  600. RETURN
  601.  
  602. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  603. C SIGN
  604. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  605. 23 CONTINUE
  606. DO 2301 IA = IDEB,IFIN
  607. XVAL2(IA)= SIGN(UN,XVAL0(IA))
  608. 2301 CONTINUE
  609. RETURN
  610.  
  611.  
  612.  
  613.  
  614. C======================================================================C
  615. C OPERATIONS TERMES A TERMES DE 2 TABLEAUX
  616. C======================================================================C
  617. 5000 CONTINUE
  618. IF (NN0 .GT. NN1)THEN
  619. NSAUT1 = NN0/NN1
  620. NSAUT2 = 0
  621. ELSEIF(NN1 .GT. NN0)THEN
  622. NSAUT1 = 0
  623. NSAUT2 = NN1/NN0
  624. ELSE
  625. NSAUT1 = 1
  626. NSAUT2 = 1
  627. ENDIF
  628. GOTO ( 5001,5002,5003,5004,5005,9999,9999,9999,9999,9999,5011 ),
  629. & IOPE
  630. C Erreur si l''operation demandee n''est pas dans la liste
  631. 9999 CONTINUE
  632. IRETOU = 21
  633. RETURN
  634.  
  635. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  636. C PUISSANCE
  637. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  638. 5001 CONTINUE
  639. IF (NN0 .EQ. NN1 ) THEN
  640. C OPERATION TERME A TERME
  641. DO 5101 IA = IDEB,IFIN
  642. XFLO = XVAL0(IA)
  643. X2 = XVAL1(IA)
  644. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  645. & (XFLO .LT. REAL(0.D0))) THEN
  646. IRETOU = 213
  647. RETURN
  648. ELSE
  649. I2 = NINT(X2)
  650. XFLOT1 = ABS (X2 - REAL(I2))
  651. XFLOT = ABS (X2 - REAL(0.5D0))
  652. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  653. C PUISSANCE ENTIERE
  654. XVAL2(IA)= XFLO ** I2
  655. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  656. C RACINE CARREE SQRT
  657. XVAL2(IA)= SQRT(XFLO)
  658. ELSE
  659. C CAS GENERAL
  660. XVAL2(IA)= XFLO ** X2
  661. ENDIF
  662. ENDIF
  663. 5101 CONTINUE
  664. ELSEIF(NN0 .GT. NN1) THEN
  665. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  666. DO 5201 IA = IDEB,IFIN
  667. IB = (IA-1) / NSAUT1 + 1
  668. XFLO = XVAL0(IB)
  669. X2 = XVAL1(IA)
  670. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  671. & (XFLO .LT. REAL(0.D0))) THEN
  672. IRETOU = 213
  673. RETURN
  674. ELSE
  675. I2 = NINT(X2)
  676. XFLOT1 = ABS(X2 - REAL(I2))
  677. XFLOT = ABS(X2 - REAL(0.5D0))
  678. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  679. C PUISSANCE ENTIERE
  680. XVAL2(IA)= XFLO ** I2
  681. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  682. C RACINE CARREE SQRT
  683. XVAL2(IA)= SQRT(XFLO)
  684. ELSE
  685. C CAS GENERAL
  686. XVAL2(IA)= XFLO ** X2
  687. ENDIF
  688. ENDIF
  689. 5201 CONTINUE
  690. ELSE
  691. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  692. DO 5301 IA = IDEB,IFIN
  693. IB = (IA-1) / NSAUT2 + 1
  694. XFLO = XVAL0(IA)
  695. X2 = XVAL1(IB)
  696. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  697. & (XFLO .LT. REAL(0.D0))) THEN
  698. IRETOU = 213
  699. RETURN
  700. ELSE
  701. I2 = NINT(X2)
  702. XFLOT1 = ABS(X2 - REAL(I2))
  703. XFLOT = ABS(X2 - REAL(0.5D0))
  704. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  705. C PUISSANCE ENTIERE
  706. XVAL2(IA)= XFLO ** I2
  707. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  708. C RACINE CARREE SQRT
  709. XVAL2(IA)= SQRT(XFLO)
  710. ELSE
  711. C CAS GENERAL
  712. XVAL2(IA)= XFLO ** X2
  713. ENDIF
  714. ENDIF
  715. 5301 CONTINUE
  716. ENDIF
  717. RETURN
  718.  
  719. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  720. C PRODUIT
  721. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  722. 5002 CONTINUE
  723. IF (NSAUT1 .EQ. 1 ) THEN
  724. C OPERATION TERME A TERME
  725. DO 5102 IA = IDEB,IFIN
  726. XVAL2(IA)= XVAL0(IA) * XVAL1(IA)
  727. 5102 CONTINUE
  728. ELSEIF(NSAUT1 .GT. 0 ) THEN
  729. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  730. DO 5202 IA = IDEB,IFIN
  731. IB = (IA-1) / NSAUT1 + 1
  732. XVAL2(IA)= XVAL0(IA) * XVAL1(IB)
  733. 5202 CONTINUE
  734. ELSE
  735. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  736. DO 5302 IA = IDEB,IFIN
  737. IB = (IA-1) / NSAUT2 + 1
  738. XVAL2(IA)= XVAL0(IB) * XVAL1(IA)
  739. 5302 CONTINUE
  740. ENDIF
  741. RETURN
  742.  
  743. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  744. C ADDITION
  745. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  746. 5003 CONTINUE
  747. IF (NSAUT1 .EQ. 1 ) THEN
  748. C OPERATION TERME A TERME
  749. DO 5103 IA=IDEB,IFIN
  750. XVAL2(IA) = XVAL0(IA) + XVAL1(IA)
  751. 5103 CONTINUE
  752. ELSEIF(NSAUT1 .GT. 0 ) THEN
  753. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  754. DO 5203 IA=IDEB,IFIN
  755. IB = (IA-1) / NSAUT1 + 1
  756. XVAL2(IA) = XVAL0(IA) + XVAL1(IB)
  757. 5203 CONTINUE
  758. ELSE
  759. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  760. DO 5303 IA=IDEB,IFIN
  761. IB = (IA-1) / NSAUT2 + 1
  762. XVAL2(IA) = XVAL0(IB) + XVAL1(IA)
  763. 5303 CONTINUE
  764. ENDIF
  765. RETURN
  766.  
  767. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  768. C SOUSTRACTION
  769. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  770. 5004 CONTINUE
  771. IF (NSAUT1 .EQ. 1 ) THEN
  772. C OPERATION TERME A TERME
  773. DO 5104 IA = IDEB,IFIN
  774. XVAL2(IA)= XVAL0(IA) - XVAL1(IA)
  775. 5104 CONTINUE
  776. ELSEIF(NSAUT1 .GT. 0 ) THEN
  777. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  778. DO 5204 IA = IDEB,IFIN
  779. IB = (IA-1) / NSAUT1 + 1
  780. XVAL2(IA)= XVAL0(IA) - XVAL1(IB)
  781. 5204 CONTINUE
  782. ELSE
  783. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  784. DO 5304 IA = IDEB,IFIN
  785. IB = (IA-1) / NSAUT2 + 1
  786. XVAL2(IA)= XVAL0(IB) - XVAL1(IA)
  787. 5304 CONTINUE
  788. ENDIF
  789. RETURN
  790.  
  791. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  792. C DIVISION
  793. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  794. 5005 CONTINUE
  795. IF (NSAUT1 .EQ. 1 ) THEN
  796. C OPERATION TERME A TERME
  797. DO 5105 IA = IDEB,IFIN
  798. X2 = XVAL1(IA)
  799. IF (ABS(X2) .GT. XPETIT) THEN
  800. XVAL2(IA)= XVAL0(IA) / X2
  801. ELSE
  802. IRETOU = 835
  803. RETURN
  804. ENDIF
  805. 5105 CONTINUE
  806. ELSEIF(NSAUT1 .GT. 0 ) THEN
  807. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  808. DO 5205 IA = IDEB,IFIN
  809. IB = (IA-1) / NSAUT1 + 1
  810. X2 = XVAL1(IB)
  811. IF (ABS(X2) .GT. XPETIT) THEN
  812. XVAL2(IA)= XVAL0(IA) / X2
  813. ELSE
  814. IRETOU = 835
  815. RETURN
  816. ENDIF
  817. 5205 CONTINUE
  818. ELSE
  819. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  820. DO 5305 IA = IDEB,IFIN
  821. IB = (IA-1) / NSAUT2 + 1
  822. X2 = XVAL1(IA)
  823. IF (ABS(X2) .GT. XPETIT) THEN
  824. XVAL2(IA)= XVAL0(IB) / X2
  825. ELSE
  826. IRETOU = 835
  827. RETURN
  828. ENDIF
  829. 5305 CONTINUE
  830. ENDIF
  831. RETURN
  832.  
  833. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  834. C ARCTANGENTE
  835. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  836. 5011 CONTINUE
  837. IF (NSAUT1 .EQ. 1 ) THEN
  838. C OPERATION TERME A TERME
  839. DO 5111 IA = IDEB,IFIN
  840. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IA))
  841. 5111 CONTINUE
  842. ELSEIF(NSAUT1 .GT. 0 ) THEN
  843. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  844. DO 5211 IA = IDEB,IFIN
  845. IB = (IA-1) / NSAUT1 + 1
  846. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IB))
  847. 5211 CONTINUE
  848. ELSE
  849. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  850. DO 5311 IA = IDEB,IFIN
  851. IB = (IA-1) / NSAUT2 + 1
  852. XVAL2(IA)= XINV * ATAN2(XVAL0(IB),XVAL1(IA))
  853. 5311 CONTINUE
  854. ENDIF
  855. RETURN
  856.  
  857. END
  858.  
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  

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