Télécharger optabj.eso

Retour à la liste

Numérotation des lignes :

  1. C OPTABJ SOURCE CB215821 17/10/04 21:15:09 9586
  2. SUBROUTINE OPTABj(NBTHR ,ITHR,IOPE,NTABEN,
  3. & XVAL0,XVAL1,XVAL2,
  4. & NN0 ,NN1 ,NN2 ,IARG ,I1I ,X1I ,IRETOU)
  5.  
  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.  
  10. C Creation 31/08/2016
  11. C Createur CB215821
  12. C Historique des Corrections apportees :
  13. C -
  14. C -
  15. C -
  16.  
  17. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  18. C NBTHR : Nombre de Thread disponibles
  19. C ITHR : Numero du Thread courant
  20. C IRETOU : Entier contenant le code d'erreur
  21. C IOPE : Type d''operation a realiser (Voir ci-dessous)
  22. C NTABEN : Nombre de tableaux constituant l''entree (Exemple : 2 pour ATAN2)
  23. C XVAL0 : Tableau de valeur d''entree
  24. C XVAL1 : Tableau de valeur d''entree (Deuxieme argument pour ATAN2)
  25. C XVAL2 : Tableau de valeur de sortie
  26. C NN0 : Taille du tableau XVAL0
  27. C NN1 : Taille du tableau XVAL1
  28. C NN2 : Taille du tableau XVAL2
  29. C
  30. C IARG = 0 ==> ARGUMENT I1I ET X1I INUTILISES
  31. C IARG = 1 ==> ARGUMENT I1I UTILISE
  32. C IARG = 11 ==> ARGUMENT I1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (PUISSANCE, SOUSTRACTION, DIVISION : POSITIONNEL)
  33. C IARG = 2 ==> ARGUMENT X1I UTILISE
  34. C IARG = 21 ==> ARGUMENT X1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (PUISSANCE, SOUSTRACTION, DIVISION : POSITIONNEL)
  35. C
  36. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  37. C
  38. C Elle realise les operations suivantes :
  39. C Operations elementaires entre un TABLEAU et un ENTIER ou FLOTTANT
  40. C IOPE = 1 PUISSANCE
  41. C = 2 PRODUIT
  42. C = 3 ADDITION
  43. C = 4 SOUSTRACTION
  44. C = 5 DIVISION
  45. C
  46. C Fonctions sur un TABLEAU
  47. C = 6 COSINUS
  48. C = 7 SINUS
  49. C = 8 TANGENTE
  50. C = 9 ARCOSINUS
  51. C = 10 ARCSINUS
  52. C = 11 ARCTANGENTE
  53. C = 12 EXPONENTIELLE
  54. C = 13 LOGARITHME
  55. C = 14 VALEUR ABSOLUE
  56. C = 15 COSINUS HYPERBOLIQUE
  57. C = 16 SINUS HYPERBOLIQUE
  58. C = 17 TANGENTE HYPERBOLIQUE
  59. C = 18 ERF FONCTION D''ERRREUR DE GAUSS
  60. C = 19 ERFC FONCTION D''ERRREUR COMPLEMENTAIRE DE GAUSS (1-ERF(X))
  61. C = 20 ARGCH (FONCTION RECIPROQUE DE COSH)
  62. C = 21 ARGSH (FONCTION RECIPROQUE DE SINH)
  63. C = 22 ARGTH (FONCTION RECIPROQUE DE TANH)
  64. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  65.  
  66. IMPLICIT INTEGER(I-N)
  67. IMPLICIT REAL*8 (A-H,O-Z)
  68.  
  69. -INC CCREEL
  70.  
  71. INTEGER NTABEN
  72.  
  73. REAL*8 XNOR,XINV,XFLOT,XFLOT1,XFLOT2,XIINV,XPREC,XTRA,X2,XF1,UN
  74. PARAMETER (XNOR = XPI / 180.D0)
  75. PARAMETER (XINV = 180.D0 / XPI)
  76. PARAMETER (UN = 1.D0)
  77.  
  78. REAL*8 XVAL0(NN0),XVAL1(NN1),XVAL2(NN2)
  79.  
  80. INTEGER IRETOU
  81.  
  82. I2 = I1I
  83. X2 = X1I
  84. IARG2 =IARG
  85. IRETOU = 0
  86.  
  87. C Decoupage pour le travail d''ecriture en parallele
  88. NNC = MAX(NN0,NN1,NN2)
  89. IRES = MOD(NNC,NBTHR)
  90. IF (IRES .EQ. 0) THEN
  91. ILON = NNC / NBTHR
  92. IDEB = (ithr -1)* ILON + 1
  93. ELSE
  94. IF (ithr .LE. IRES) THEN
  95. ILON = (NNC / NBTHR) + 1
  96. IDEB = (ithr -1)* ILON + 1
  97. ELSE
  98. ILON = NNC / NBTHR
  99. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  100. ENDIF
  101. ENDIF
  102. IFIN = IDEB + ILON - 1
  103.  
  104. IF (NTABEN .EQ. 2) GOTO 5000
  105.  
  106. C======================================================================C
  107. C OPERATIONS ENTRE UN TABLEAU ET UN FLOTTANT / ENTIER
  108. C======================================================================C
  109. IF (IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) THEN
  110. X2 = REAL(I1I)
  111. ELSEIF(IARG2 .NE. 0 .AND. IARG2 .NE. 2 .AND. IARG2 .NE. 21) THEN
  112. C Surveillance de la validite des PARAMETRES d'entree
  113. IRETOU = 21
  114. RETURN
  115. ENDIF
  116.  
  117. C PRINT *, 'OPTABJ',ITHR,IOPE,NN0
  118. GOTO ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,
  119. & 18,19,20,21,22 ),IOPE
  120. C Erreur si l''operation demandee n''est pas dans la liste
  121. IRETOU = 21
  122. RETURN
  123.  
  124. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  125. C PUISSANCE
  126. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  127. 1 CONTINUE
  128. IF (IARG2 .EQ. 1) THEN
  129. C PRINT *,'TABLEAU ** ENTIER',ITHR
  130. IF (I2 .EQ. 0) THEN
  131. C PRINT *,' Cas TABLEAU ** 0'
  132. DO 101 IA = IDEB,IFIN
  133. XVAL2(IA)= REAL(1.D0)
  134. 101 CONTINUE
  135. RETURN
  136.  
  137. ELSEIF(I2 .EQ. 1)THEN
  138. C PRINT *,' Cas TABLEAU ** 1'
  139. DO 102 IA = IDEB,IFIN
  140. XVAL2(IA)= XVAL0(IA)
  141. 102 CONTINUE
  142. RETURN
  143.  
  144. ELSE
  145. DO 103 IA = IDEB,IFIN
  146. XTRA=XVAL0(IA)
  147. IF(ABS(XTRA).LE.XPETIT .AND. I2.LT.0)THEN
  148. IRETOU = 213
  149. RETURN
  150. ELSE
  151. XVAL2(IA)= XTRA ** I2
  152. ENDIF
  153. 103 CONTINUE
  154. RETURN
  155. ENDIF
  156. RETURN
  157.  
  158. ELSEIF(IARG2 .EQ. 2) THEN
  159. C PRINT *,'TABLEAU ** FLOTTANT',ITHR
  160. I2 = NINT(X2)
  161. XFLOT = ABS(X2 - REAL(I2))
  162. XPREC = (XZPREC*ABS(X2)*REAL(2.D0))
  163.  
  164. C Verification si puissance ENTIERE possible
  165. IF ( XFLOT .LE. XPREC) THEN
  166. IARG2=1
  167. GOTO 1
  168. ENDIF
  169.  
  170. C Verification si SQRT possible
  171. XF1 = X2 - REAL(0.5D0)
  172. I2 = NINT(XF1)
  173. I3 = (I2 * 2) + 1
  174. XFLOT = ABS(XF1 - REAL(I2))
  175. IF (XFLOT .LE. XPREC) THEN
  176. IF (I2 .EQ. 0) THEN
  177. C PRINT *,' Cas SQRT simple'
  178. DO 104 IA = IDEB,IFIN
  179. IF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  180. IRETOU = 213
  181. RETURN
  182. ELSE
  183. XVAL2(IA)= SQRT(XVAL0(IA))
  184. ENDIF
  185. 104 CONTINUE
  186. RETURN
  187.  
  188. ELSE
  189. C PRINT *,' Nouveau cas SQRT ** I3',I3
  190. DO 105 IA = IDEB,IFIN
  191. IF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  192. IRETOU = 213
  193. RETURN
  194. ELSE
  195. XVAL2(IA)= (SQRT(XVAL0(IA))) ** I3
  196. ENDIF
  197. 105 CONTINUE
  198. RETURN
  199. ENDIF
  200. RETURN
  201.  
  202. ELSE
  203. C Verification si racine Nieme possible
  204. IF (X2 .GT. XPETIT) THEN
  205. XIINV=UN/X2
  206. IINV = NINT(XIINV)
  207. XFLOT= ABS(XIINV - REAL(IINV))
  208. XPREC= XZPREC*ABS(XIINV)*REAL(2.D0)
  209.  
  210. IF (XFLOT .LE. XPREC .AND. MOD(IINV,2).NE. 0) THEN
  211. C PRINT *,' Racine Nieme'
  212. DO 106 IA = IDEB,IFIN
  213. XFLOT = XVAL0(IA)
  214. XVAL2(IA)=SIGN(UN,XFLOT)*(ABS(XFLOT)**X2)
  215. 106 CONTINUE
  216. RETURN
  217. ENDIF
  218. ENDIF
  219.  
  220. C PRINT *,' Cas general'
  221. DO 107 IA = IDEB,IFIN
  222. IF ((ABS(XVAL0(IA)) .LE. XPETIT) .AND.
  223. & (X2 .LT. REAL(0.D0))) THEN
  224. IRETOU = 213
  225. RETURN
  226. ELSEIF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  227. IRETOU = 213
  228. RETURN
  229. ELSE
  230. XVAL2(IA)= XVAL0(IA) ** X2
  231. ENDIF
  232. 107 CONTINUE
  233. RETURN
  234. ENDIF
  235. RETURN
  236.  
  237. ELSEIF(IARG2 .EQ. 11 .OR. IARG2 .EQ. 21) THEN
  238. C PRINT *,'ENTIER ** TABLEAU ou FLOTTANT ** TABLEAU'
  239. DO 108 IA = IDEB,IFIN
  240. I2 = NINT(XVAL0(IA))
  241. XFLOT1= ABS(XVAL0(IA) - REAL(I2 ))
  242. XFLOT2= ABS(XVAL0(IA) - REAL(0.5D0))
  243. XPREC = (XZPREC*ABS(XVAL0(IA))*REAL(2.D0))
  244. IF (((ABS(X2) .LE. XPETIT) .AND.
  245. & (XVAL0(IA).LT.REAL(0.D0) )) .OR.
  246. & (X2 .LT. REAL(0.D0))) THEN
  247. IRETOU = 213
  248. RETURN
  249. ELSEIF ( XFLOT1 .LE. XPREC ) THEN
  250. C PRINT *,' Puissance Entiere Possible'
  251. XVAL2(IA)= X2 ** I2
  252. ELSEIF ( XFLOT2 .LE. XPREC) THEN
  253. C PRINT *,' SQRT Possible'
  254. XVAL2(IA)= SQRT(X2)
  255. ELSE
  256. C PRINT *,' Cas general'
  257. XVAL2(IA)= X2 ** XVAL0(IA)
  258. ENDIF
  259. 108 CONTINUE
  260. RETURN
  261. ENDIF
  262. RETURN
  263.  
  264. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  265. C PRODUIT
  266. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  267. 2 CONTINUE
  268. IF ((IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) .AND. (I1I .EQ. 0)) THEN
  269. C PRINT *,'PRODUIT Cas 1'
  270. RETURN
  271. C ELSEIF((IARG2 .EQ. 2 .OR. IARG2 .EQ. 21) .AND.
  272. C & (ABS(X2) .LE. XPETIT)) THEN
  273. CC PRINT *,'PRODUIT Cas 2', Le produit par XPETIT n'est pas forcement nul !!!
  274. C RETURN
  275. ENDIF
  276. C PRINT *,'PRODUIT Cas 3'
  277. DO 201 IA = IDEB,IFIN
  278. XVAL2(IA)= XVAL0(IA) * X2
  279. 201 CONTINUE
  280. RETURN
  281.  
  282. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  283. C ADDITION
  284. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  285. 3 CONTINUE
  286. IF ((IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) .AND. (I1I .EQ. 0)) THEN
  287. C PRINT *,'ADDITION Cas 1'
  288. DO 301 IA=IDEB,IFIN
  289. XVAL2(IA) = XVAL0(IA)
  290. 301 CONTINUE
  291. RETURN
  292. C ELSEIF((IARG2 .EQ. 2 .OR. IARG2 .EQ. 21) .AND.
  293. C & (ABS(X2) .LE. XPETIT)) THEN
  294. CC PRINT *,'ADDITION Cas 2' Ajouter XPETIT n'est pas forcement negligeable !!!
  295. C DO 302 IA=IDEB,IFIN
  296. C XVAL2(IA) = XVAL0(IA)
  297. C 302 CONTINUE
  298. C RETURN
  299. ENDIF
  300. C PRINT *,'ADDITION Cas 3'
  301. DO 303 IA=IDEB,IFIN
  302. XVAL2(IA) = XVAL0(IA) + X2
  303. 303 CONTINUE
  304. RETURN
  305.  
  306. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  307. C SOUSTRACTION
  308. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  309. 4 CONTINUE
  310. IF (IARG2 .EQ. 1 .AND. I1I .EQ. 0) THEN
  311. C PRINT *,'SOUSTRACTION Cas 1'
  312. DO 401 IA=IDEB,IFIN
  313. XVAL2(IA) = XVAL0(IA)
  314. 401 CONTINUE
  315. RETURN
  316. C ELSEIF(IARG2 .EQ. 2 .AND. (ABS(X2) .LE. XPETIT)) THEN
  317. CC PRINT *,'SOUSTRACTION Cas 2' Soustraire XPETIT n'est pas forcement negligeable !!!
  318. C DO 402 IA=IDEB,IFIN
  319. C XVAL2(IA) = XVAL0(IA)
  320. C 402 CONTINUE
  321. C RETURN
  322. ENDIF
  323. IF (IARG2 .EQ. 11 .AND. I1I .EQ. 0) THEN
  324. C PRINT *,'SOUSTRACTION Cas 3'
  325. DO 403 IA=IDEB,IFIN
  326. XVAL2(IA) = -XVAL0(IA)
  327. 403 CONTINUE
  328. RETURN
  329. C ELSEIF(IARG2 .EQ. 21 .AND. (ABS(X2) .LE. XPETIT)) THEN
  330. CC PRINT *,'SOUSTRACTION Cas 4' Soustraire a XPETIT n'est pas forcement negligeable !!!
  331. C DO 404 IA=IDEB,IFIN
  332. C XVAL2(IA) = -XVAL0(IA)
  333. C 404 CONTINUE
  334. C RETURN
  335. ENDIF
  336. IF (IARG2 .EQ. 1) THEN
  337. C Cas TABLEAU - I1I
  338. C PRINT *,'SOUSTRACTION Cas 5'
  339. DO 405 IA = IDEB,IFIN
  340. XVAL2(IA)= XVAL0(IA) - X2
  341. 405 CONTINUE
  342. RETURN
  343. ELSEIF(IARG2 .EQ. 2) THEN
  344. C Cas TABLEAU - X2
  345. C PRINT *,'SOUSTRACTION Cas 6'
  346. DO 406 IA = IDEB,IFIN
  347. XVAL2(IA)= XVAL0(IA) - X2
  348. 406 CONTINUE
  349. RETURN
  350. ELSEIF(IARG2 .EQ. 11) THEN
  351. C Cas I1I - TABLEAU
  352. C PRINT *,'SOUSTRACTION Cas 7'
  353. DO 407 IA = IDEB,IFIN
  354. XVAL2(IA)= X2 - XVAL0(IA)
  355. 407 CONTINUE
  356. RETURN
  357. ELSEIF(IARG2 .EQ. 21) THEN
  358. C Cas X2 - TABLEAU
  359. C PRINT *,'SOUSTRACTION Cas 8'
  360. DO 408 IA = IDEB,IFIN
  361. XVAL2(IA)= X2 - XVAL0(IA)
  362. 408 CONTINUE
  363. RETURN
  364. ENDIF
  365. RETURN
  366.  
  367. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  368. C DIVISION
  369. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  370. 5 CONTINUE
  371. IF(IARG2 .EQ. 11 .AND. I1I .EQ. 0) THEN
  372. C PRINT *,'DIVISION Cas 1'
  373. RETURN
  374. C ELSEIF(IARG2 .EQ. 21 .AND. (ABS(X2) .LE. XPETIT)) THEN
  375. CC PRINT *,'DIVISION Cas 2' XPETIT divise par qqc n'est pas forcement negligeable !!!
  376. C RETURN
  377. ENDIF
  378. IF (IARG2 .EQ. 1) THEN
  379. IF (I1I .NE. 0) THEN
  380. C PRINT *,'DIVISION Cas 3'
  381. DO 501 IA = IDEB,IFIN
  382. C Cas TABLEAU / ENTIER
  383. XVAL2(IA)= XVAL0(IA) / X2
  384. 501 CONTINUE
  385. RETURN
  386. ELSE
  387. IRETOU = 835
  388. RETURN
  389. ENDIF
  390. ELSEIF (IARG2 .EQ. 2) THEN
  391. IF (ABS(X2) .GT. XPETIT) THEN
  392. C PRINT *,'DIVISION Cas 4'
  393. X3 = 1.D0 / X2
  394. DO 502 IA = IDEB,IFIN
  395. C Cas TABLEAU / FLOTTANT
  396. XVAL2(IA)= XVAL0(IA) * X3
  397. 502 CONTINUE
  398. RETURN
  399. ELSE
  400. IRETOU = 835
  401. RETURN
  402. ENDIF
  403. ELSEIF(IARG2 .EQ. 11 .OR. IARG2 .EQ. 21) THEN
  404. C PRINT *,'DIVISION Cas 5'
  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.  
  603.  
  604.  
  605. C======================================================================C
  606. C OPERATIONS TERMES A TERMES DE 2 TABLEAUX
  607. C======================================================================C
  608. 5000 CONTINUE
  609. NSAUT1 = NN0/NN1
  610. NSAUT2 = NN1/NN0
  611. GOTO ( 5001,5002,5003,5004,5005,9999,9999,9999,9999,9999,5011 ),
  612. & IOPE
  613. C Erreur si l''operation demandee n''est pas dans la liste
  614. 9999 CONTINUE
  615. IRETOU = 21
  616. RETURN
  617.  
  618. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  619. C PUISSANCE
  620. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  621. 5001 CONTINUE
  622. IF (NN0 .EQ. NN1 ) THEN
  623. C OPERATION TERME A TERME
  624. DO 5101 IA = IDEB,IFIN
  625. XFLO = XVAL0(IA)
  626. X2 = XVAL1(IA)
  627. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  628. & (XFLO .LT. REAL(0.D0))) THEN
  629. IRETOU = 213
  630. RETURN
  631. ELSE
  632. I2 = NINT(X2)
  633. XFLOT1 = ABS(X2 - REAL(I2))
  634. XFLOT = ABS(X2 - REAL(0.5D0))
  635. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  636. C PUISSANCE ENTIERE
  637. XVAL2(IA)= XFLO ** I2
  638. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  639. C RACINE CARREE SQRT
  640. XVAL2(IA)= SQRT(XFLO)
  641. ELSE
  642. C CAS GENERAL
  643. XVAL2(IA)= XFLO ** X2
  644. ENDIF
  645. ENDIF
  646. 5101 CONTINUE
  647. ELSEIF(NN0 .GT. NN1) THEN
  648. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  649. DO 5201 IA = IDEB,IFIN
  650. IB = (IA-1) / NSAUT1 + 1
  651. XFLO = XVAL0(IB)
  652. X2 = XVAL1(IA)
  653. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  654. & (XFLO .LT. REAL(0.D0))) THEN
  655. IRETOU = 213
  656. RETURN
  657. ELSE
  658. I2 = NINT(X2)
  659. XFLOT1 = ABS(X2 - REAL(I2))
  660. XFLOT = ABS(X2 - REAL(0.5D0))
  661. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  662. C PUISSANCE ENTIERE
  663. XVAL2(IA)= XFLO ** I2
  664. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  665. C RACINE CARREE SQRT
  666. XVAL2(IA)= SQRT(XFLO)
  667. ELSE
  668. C CAS GENERAL
  669. XVAL2(IA)= XFLO ** X2
  670. ENDIF
  671. ENDIF
  672. 5201 CONTINUE
  673. ELSE
  674. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  675. DO 5301 IA = IDEB,IFIN
  676. IB = (IA-1) / NSAUT2 + 1
  677. XFLO = XVAL0(IA)
  678. X2 = XVAL1(IB)
  679. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  680. & (XFLO .LT. REAL(0.D0))) THEN
  681. IRETOU = 213
  682. RETURN
  683. ELSE
  684. I2 = NINT(X2)
  685. XFLOT1 = ABS(X2 - REAL(I2))
  686. XFLOT = ABS(X2 - REAL(0.5D0))
  687. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  688. C PUISSANCE ENTIERE
  689. XVAL2(IA)= XFLO ** I2
  690. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  691. C RACINE CARREE SQRT
  692. XVAL2(IA)= SQRT(XFLO)
  693. ELSE
  694. C CAS GENERAL
  695. XVAL2(IA)= XFLO ** X2
  696. ENDIF
  697. ENDIF
  698. 5301 CONTINUE
  699. ENDIF
  700. RETURN
  701.  
  702. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  703. C PRODUIT
  704. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  705. 5002 CONTINUE
  706. IF (NSAUT1 .EQ. 1 ) THEN
  707. C OPERATION TERME A TERME
  708. DO 5102 IA = IDEB,IFIN
  709. XVAL2(IA)= XVAL0(IA) * XVAL1(IA)
  710. 5102 CONTINUE
  711. ELSEIF(NSAUT1 .GT. 0 ) THEN
  712. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  713. DO 5202 IA = IDEB,IFIN
  714. IB = (IA-1) / NSAUT1 + 1
  715. XVAL2(IA)= XVAL0(IA) * XVAL1(IB)
  716. 5202 CONTINUE
  717. ELSE
  718. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  719. DO 5302 IA = IDEB,IFIN
  720. IB = (IA-1) / NSAUT2 + 1
  721. XVAL2(IA)= XVAL0(IB) * XVAL1(IA)
  722. 5302 CONTINUE
  723. ENDIF
  724. RETURN
  725.  
  726. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  727. C ADDITION
  728. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  729. 5003 CONTINUE
  730. IF (NSAUT1 .EQ. 1 ) THEN
  731. C OPERATION TERME A TERME
  732. DO 5103 IA=IDEB,IFIN
  733. XVAL2(IA) = XVAL0(IA) + XVAL1(IA)
  734. 5103 CONTINUE
  735. ELSEIF(NSAUT1 .GT. 0 ) THEN
  736. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  737. DO 5203 IA=IDEB,IFIN
  738. IB = (IA-1) / NSAUT1 + 1
  739. XVAL2(IA) = XVAL0(IA) + XVAL1(IB)
  740. 5203 CONTINUE
  741. ELSE
  742. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  743. DO 5303 IA=IDEB,IFIN
  744. IB = (IA-1) / NSAUT2 + 1
  745. XVAL2(IA) = XVAL0(IB) + XVAL1(IA)
  746. 5303 CONTINUE
  747. ENDIF
  748. RETURN
  749.  
  750. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  751. C SOUSTRACTION
  752. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  753. 5004 CONTINUE
  754. IF (NSAUT1 .EQ. 1 ) THEN
  755. C OPERATION TERME A TERME
  756. DO 5104 IA = IDEB,IFIN
  757. XVAL2(IA)= XVAL0(IA) - XVAL1(IA)
  758. 5104 CONTINUE
  759. ELSEIF(NSAUT1 .GT. 0 ) THEN
  760. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  761. DO 5204 IA = IDEB,IFIN
  762. IB = (IA-1) / NSAUT1 + 1
  763. XVAL2(IA)= XVAL0(IA) - XVAL1(IB)
  764. 5204 CONTINUE
  765. ELSE
  766. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  767. DO 5304 IA = IDEB,IFIN
  768. IB = (IA-1) / NSAUT2 + 1
  769. XVAL2(IA)= XVAL0(IB) - XVAL1(IA)
  770. 5304 CONTINUE
  771. ENDIF
  772. RETURN
  773.  
  774. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  775. C DIVISION
  776. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  777. 5005 CONTINUE
  778. IF (NSAUT1 .EQ. 1 ) THEN
  779. C OPERATION TERME A TERME
  780. DO 5105 IA = IDEB,IFIN
  781. X2 = XVAL1(IA)
  782. IF (ABS(X2) .GT. XPETIT) THEN
  783. XVAL2(IA)= XVAL0(IA) / X2
  784. ELSE
  785. IRETOU = 835
  786. RETURN
  787. ENDIF
  788. 5105 CONTINUE
  789. ELSEIF(NSAUT1 .GT. 0 ) THEN
  790. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  791. DO 5205 IA = IDEB,IFIN
  792. IB = (IA-1) / NSAUT1 + 1
  793. X2 = XVAL1(IB)
  794. IF (ABS(X2) .GT. XPETIT) THEN
  795. XVAL2(IA)= XVAL0(IA) / X2
  796. ELSE
  797. IRETOU = 835
  798. RETURN
  799. ENDIF
  800. 5205 CONTINUE
  801. ELSE
  802. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  803. DO 5305 IA = IDEB,IFIN
  804. IB = (IA-1) / NSAUT2 + 1
  805. X2 = XVAL1(IA)
  806. IF (ABS(X2) .GT. XPETIT) THEN
  807. XVAL2(IA)= XVAL0(IB) / X2
  808. ELSE
  809. IRETOU = 835
  810. RETURN
  811. ENDIF
  812. 5305 CONTINUE
  813. ENDIF
  814. RETURN
  815.  
  816. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  817. C ARCTANGENTE
  818. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  819. 5011 CONTINUE
  820. IF (NSAUT1 .EQ. 1 ) THEN
  821. C OPERATION TERME A TERME
  822. DO 5111 IA = IDEB,IFIN
  823. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IA))
  824. 5111 CONTINUE
  825. ELSEIF(NSAUT1 .GT. 0 ) THEN
  826. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  827. DO 5211 IA = IDEB,IFIN
  828. IB = (IA-1) / NSAUT1 + 1
  829. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IB))
  830. 5211 CONTINUE
  831. ELSE
  832. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  833. DO 5311 IA = IDEB,IFIN
  834. IB = (IA-1) / NSAUT2 + 1
  835. XVAL2(IA)= XINV * ATAN2(XVAL0(IB),XVAL1(IA))
  836. 5311 CONTINUE
  837. ENDIF
  838. RETURN
  839.  
  840. END
  841.  
  842.  
  843.  
  844.  
  845.  

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