Télécharger optabj.eso

Retour à la liste

Numérotation des lignes :

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

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