Télécharger optabj.eso

Retour à la liste

Numérotation des lignes :

  1. C OPTABJ SOURCE CB215821 17/02/06 21:15:07 9301
  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. DO 502 IA = IDEB,IFIN
  392. C Cas TABLEAU / FLOTTANT
  393. XVAL2(IA)= XVAL0(IA) / X2
  394. 502 CONTINUE
  395. RETURN
  396. ELSE
  397. IERROR(ithr) = 835
  398. RETURN
  399. ENDIF
  400. ELSEIF(IARG2 .EQ. 11 .OR. IARG2 .EQ. 21) THEN
  401. C PRINT *,'DIVISION Cas 5'
  402. DO 503 IA = IDEB,IFIN
  403. C Cas FLOTTANT / TABLEAU ou ENTIER / TABLEAU (terme a terme)
  404. IF (ABS(XVAL0(IA)) .GT. XPETIT) THEN
  405. XVAL2(IA)= X2 / XVAL0(IA)
  406. ELSE
  407. IERROR(ithr) = 835
  408. RETURN
  409. ENDIF
  410. 503 CONTINUE
  411. RETURN
  412. ENDIF
  413. RETURN
  414.  
  415. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  416. C COSINUS
  417. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  418. 6 CONTINUE
  419. DO 601 IA = IDEB,IFIN
  420. XVAL2(IA)= COS(XNOR * XVAL0(IA))
  421. 601 CONTINUE
  422. RETURN
  423.  
  424. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  425. C SINUS
  426. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  427. 7 CONTINUE
  428. DO 701 IA = IDEB,IFIN
  429. XVAL2(IA)= SIN(XNOR * XVAL0(IA))
  430. 701 CONTINUE
  431. RETURN
  432.  
  433. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  434. C TANGENTE
  435. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  436. 8 CONTINUE
  437. DO 801 IA = IDEB,IFIN
  438. XVAL2(IA)= TAN(XNOR * XVAL0(IA))
  439. 801 CONTINUE
  440. RETURN
  441.  
  442. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  443. C ARCCOS
  444. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  445. 9 CONTINUE
  446. DO 901 IA = IDEB,IFIN
  447. X2 = XVAL0(IA)
  448. IF (ABS(X2) .LE. UN) THEN
  449. XVAL2(IA)= XINV * ACOS(X2)
  450. ELSE
  451. IERROR(ithr) = 21
  452. RETURN
  453. ENDIF
  454. 901 CONTINUE
  455. RETURN
  456.  
  457. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  458. C ARCSIN
  459. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  460. 10 CONTINUE
  461. DO 1001 IA = IDEB,IFIN
  462. X2 = XVAL0(IA)
  463. IF (ABS(X2) .LE. UN) THEN
  464. XVAL2(IA)= XINV * ASIN(X2)
  465. ELSE
  466. IERROR(ithr) = 21
  467. RETURN
  468. ENDIF
  469. 1001 CONTINUE
  470. RETURN
  471.  
  472. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  473. C ARCTANGENTE
  474. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  475. 11 CONTINUE
  476. DO 1101 IA = IDEB,IFIN
  477. XVAL2(IA)= XINV * ATAN(XVAL0(IA))
  478. 1101 CONTINUE
  479. RETURN
  480.  
  481. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  482. C EXPONENTIELLE
  483. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  484. 12 CONTINUE
  485. DO 1201 IA = IDEB,IFIN
  486. XVAL2(IA)= EXP(XVAL0(IA))
  487. 1201 CONTINUE
  488. RETURN
  489.  
  490. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  491. C LOGARITHME
  492. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  493. 13 CONTINUE
  494. DO 1301 IA = IDEB,IFIN
  495. X2 = XVAL0(IA)
  496. IF (X2 .GT. XPETIT) THEN
  497. XVAL2(IA)= LOG(X2)
  498. ELSE
  499. IERROR(ithr) = 21
  500. RETURN
  501. ENDIF
  502. 1301 CONTINUE
  503. RETURN
  504.  
  505. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  506. C VALEUR ABSOLUE
  507. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  508. 14 CONTINUE
  509. DO 1401 IA = IDEB,IFIN
  510. XVAL2(IA)= ABS(XVAL0(IA))
  511. 1401 CONTINUE
  512. RETURN
  513.  
  514. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  515. C COSINUS HYPERBOLIQUE
  516. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  517. 15 CONTINUE
  518. DO 1501 IA = IDEB,IFIN
  519. XVAL2(IA)= COSH(XVAL0(IA))
  520. 1501 CONTINUE
  521. RETURN
  522.  
  523. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  524. C SINUS HYPERBOLIQUE
  525. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  526. 16 CONTINUE
  527. DO 1601 IA = IDEB,IFIN
  528. XVAL2(IA)= SINH(XVAL0(IA))
  529. 1601 CONTINUE
  530. RETURN
  531.  
  532. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  533. C TANGENTE HYPERBOLIQUE
  534. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  535. 17 CONTINUE
  536. DO 1701 IA = IDEB,IFIN
  537. XVAL2(IA)= TANH(XVAL0(IA))
  538. 1701 CONTINUE
  539. RETURN
  540.  
  541. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  542. C ERF (Fonction Erreur)
  543. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  544. 18 CONTINUE
  545. DO 1801 IA = IDEB,IFIN
  546. XVAL2(IA)= ERF(XVAL0(IA))
  547. 1801 CONTINUE
  548. RETURN
  549.  
  550. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  551. C ERFC (Fonction Erreur Complementaire 1-ERF(x))
  552. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  553. 19 CONTINUE
  554. DO 1901 IA = IDEB,IFIN
  555. XVAL2(IA)= ERFC(XVAL0(IA))
  556. 1901 CONTINUE
  557. RETURN
  558.  
  559. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  560. C ARCOSH
  561. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  562. 20 CONTINUE
  563. DO 2001 IA = IDEB,IFIN
  564. X2 = XVAL0(IA)
  565. IF (X2 .GE. UN) THEN
  566. XVAL2(IA)= LOG(X2 + SQRT((X2**2) - UN))
  567. ELSE
  568. IERROR(ithr) = 21
  569. RETURN
  570. ENDIF
  571. 2001 CONTINUE
  572. RETURN
  573.  
  574. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  575. C ARSINH
  576. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  577. 21 CONTINUE
  578. DO 2101 IA = IDEB,IFIN
  579. X2 = XVAL0(IA)
  580. XVAL2(IA)= LOG(X2 + SQRT((X2**2) + UN))
  581. 2101 CONTINUE
  582. RETURN
  583.  
  584. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  585. C ARTANH
  586. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  587. 22 CONTINUE
  588. DO 2201 IA = IDEB,IFIN
  589. X2 = XVAL0(IA)
  590. IF (ABS(X2) .LT. UN) THEN
  591. XVAL2(IA)=REAL(0.5D0)*LOG((UN+X2) / (UN - X2))
  592. ELSE
  593. IERROR(ithr) = 21
  594. RETURN
  595. ENDIF
  596. 2201 CONTINUE
  597. RETURN
  598.  
  599.  
  600.  
  601.  
  602. C======================================================================C
  603. C OPERATIONS TERMES A TERMES DE 2 TABLEAUX
  604. C======================================================================C
  605. 5000 CONTINUE
  606. NSAUT1 = NN0/NN1
  607. NSAUT2 = NN1/NN0
  608. GOTO ( 5001,5002,5003,5004,5005,9999,9999,9999,9999,9999,5011 ),
  609. & IOPE
  610. C Erreur si l''operation demandee n''est pas dans la liste
  611. 9999 CONTINUE
  612. IERROR(ithr) = 21
  613. RETURN
  614.  
  615. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  616. C PUISSANCE
  617. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  618. 5001 CONTINUE
  619. IF (NN0 .EQ. NN1 ) THEN
  620. C OPERATION TERME A TERME
  621. DO 5101 IA = IDEB,IFIN
  622. XFLO = XVAL0(IA)
  623. X2 = XVAL1(IA)
  624. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  625. & (XFLO .LT. REAL(0.D0))) THEN
  626. IERROR(ithr) = 213
  627. RETURN
  628. ELSE
  629. I2 = NINT(X2)
  630. XFLOT1 = ABS(X2 - REAL(I2))
  631. XFLOT = ABS(X2 - REAL(0.5D0))
  632. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  633. C PUISSANCE ENTIERE
  634. XVAL2(IA)= XFLO ** I2
  635. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  636. C RACINE CARREE SQRT
  637. XVAL2(IA)= SQRT(XFLO)
  638. ELSE
  639. C CAS GENERAL
  640. XVAL2(IA)= XFLO ** X2
  641. ENDIF
  642. ENDIF
  643. 5101 CONTINUE
  644. ELSEIF(NN0 .GT. NN1) THEN
  645. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  646. DO 5201 IA = IDEB,IFIN
  647. IB = (IA-1) / NSAUT1 + 1
  648. XFLO = XVAL0(IB)
  649. X2 = XVAL1(IA)
  650. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  651. & (XFLO .LT. REAL(0.D0))) THEN
  652. IERROR(ithr) = 213
  653. RETURN
  654. ELSE
  655. I2 = NINT(X2)
  656. XFLOT1 = ABS(X2 - REAL(I2))
  657. XFLOT = ABS(X2 - REAL(0.5D0))
  658. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  659. C PUISSANCE ENTIERE
  660. XVAL2(IA)= XFLO ** I2
  661. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  662. C RACINE CARREE SQRT
  663. XVAL2(IA)= SQRT(XFLO)
  664. ELSE
  665. C CAS GENERAL
  666. XVAL2(IA)= XFLO ** X2
  667. ENDIF
  668. ENDIF
  669. 5201 CONTINUE
  670. ELSE
  671. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  672. DO 5301 IA = IDEB,IFIN
  673. IB = (IA-1) / NSAUT2 + 1
  674. XFLO = XVAL0(IA)
  675. X2 = XVAL1(IB)
  676. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  677. & (XFLO .LT. REAL(0.D0))) THEN
  678. IERROR(ithr) = 213
  679. RETURN
  680. ELSE
  681. I2 = NINT(X2)
  682. XFLOT1 = ABS(X2 - REAL(I2))
  683. XFLOT = ABS(X2 - REAL(0.5D0))
  684. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  685. C PUISSANCE ENTIERE
  686. XVAL2(IA)= XFLO ** I2
  687. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  688. C RACINE CARREE SQRT
  689. XVAL2(IA)= SQRT(XFLO)
  690. ELSE
  691. C CAS GENERAL
  692. XVAL2(IA)= XFLO ** X2
  693. ENDIF
  694. ENDIF
  695. 5301 CONTINUE
  696. ENDIF
  697. RETURN
  698.  
  699. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  700. C PRODUIT
  701. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  702. 5002 CONTINUE
  703. IF (NSAUT1 .EQ. 1 ) THEN
  704. C OPERATION TERME A TERME
  705. DO 5102 IA = IDEB,IFIN
  706. XVAL2(IA)= XVAL0(IA) * XVAL1(IA)
  707. 5102 CONTINUE
  708. ELSEIF(NSAUT1 .GT. 0 ) THEN
  709. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  710. DO 5202 IA = IDEB,IFIN
  711. IB = (IA-1) / NSAUT1 + 1
  712. XVAL2(IA)= XVAL0(IA) * XVAL1(IB)
  713. 5202 CONTINUE
  714. ELSE
  715. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  716. DO 5302 IA = IDEB,IFIN
  717. IB = (IA-1) / NSAUT2 + 1
  718. XVAL2(IA)= XVAL0(IB) * XVAL1(IA)
  719. 5302 CONTINUE
  720. ENDIF
  721. RETURN
  722.  
  723. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  724. C ADDITION
  725. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  726. 5003 CONTINUE
  727. IF (NSAUT1 .EQ. 1 ) THEN
  728. C OPERATION TERME A TERME
  729. DO 5103 IA=IDEB,IFIN
  730. XVAL2(IA) = XVAL0(IA) + XVAL1(IA)
  731. 5103 CONTINUE
  732. ELSEIF(NSAUT1 .GT. 0 ) THEN
  733. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  734. DO 5203 IA=IDEB,IFIN
  735. IB = (IA-1) / NSAUT1 + 1
  736. XVAL2(IA) = XVAL0(IA) + XVAL1(IB)
  737. 5203 CONTINUE
  738. ELSE
  739. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  740. DO 5303 IA=IDEB,IFIN
  741. IB = (IA-1) / NSAUT2 + 1
  742. XVAL2(IA) = XVAL0(IB) + XVAL1(IA)
  743. 5303 CONTINUE
  744. ENDIF
  745. RETURN
  746.  
  747. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  748. C SOUSTRACTION
  749. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  750. 5004 CONTINUE
  751. IF (NSAUT1 .EQ. 1 ) THEN
  752. C OPERATION TERME A TERME
  753. DO 5104 IA = IDEB,IFIN
  754. XVAL2(IA)= XVAL0(IA) - XVAL1(IA)
  755. 5104 CONTINUE
  756. ELSEIF(NSAUT1 .GT. 0 ) THEN
  757. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  758. DO 5204 IA = IDEB,IFIN
  759. IB = (IA-1) / NSAUT1 + 1
  760. XVAL2(IA)= XVAL0(IA) - XVAL1(IB)
  761. 5204 CONTINUE
  762. ELSE
  763. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  764. DO 5304 IA = IDEB,IFIN
  765. IB = (IA-1) / NSAUT2 + 1
  766. XVAL2(IA)= XVAL0(IB) - XVAL1(IA)
  767. 5304 CONTINUE
  768. ENDIF
  769. RETURN
  770.  
  771. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  772. C DIVISION
  773. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  774. 5005 CONTINUE
  775. IF (NSAUT1 .EQ. 1 ) THEN
  776. C OPERATION TERME A TERME
  777. DO 5105 IA = IDEB,IFIN
  778. X2 = XVAL1(IA)
  779. IF (ABS(X2) .GT. XPETIT) THEN
  780. XVAL2(IA)= XVAL0(IA) / X2
  781. ELSE
  782. IERROR(ithr) = 835
  783. RETURN
  784. ENDIF
  785. 5105 CONTINUE
  786. ELSEIF(NSAUT1 .GT. 0 ) THEN
  787. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  788. DO 5205 IA = IDEB,IFIN
  789. IB = (IA-1) / NSAUT1 + 1
  790. X2 = XVAL1(IB)
  791. IF (ABS(X2) .GT. XPETIT) THEN
  792. XVAL2(IA)= XVAL0(IA) / X2
  793. ELSE
  794. IERROR(ithr) = 835
  795. RETURN
  796. ENDIF
  797. 5205 CONTINUE
  798. ELSE
  799. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  800. DO 5305 IA = IDEB,IFIN
  801. IB = (IA-1) / NSAUT2 + 1
  802. X2 = XVAL1(IA)
  803. IF (ABS(X2) .GT. XPETIT) THEN
  804. XVAL2(IA)= XVAL0(IB) / X2
  805. ELSE
  806. IERROR(ithr) = 835
  807. RETURN
  808. ENDIF
  809. 5305 CONTINUE
  810. ENDIF
  811. RETURN
  812.  
  813. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  814. C ARCTANGENTE
  815. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  816. 5011 CONTINUE
  817. IF (NSAUT1 .EQ. 1 ) THEN
  818. C OPERATION TERME A TERME
  819. DO 5111 IA = IDEB,IFIN
  820. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IA))
  821. 5111 CONTINUE
  822. ELSEIF(NSAUT1 .GT. 0 ) THEN
  823. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  824. DO 5211 IA = IDEB,IFIN
  825. IB = (IA-1) / NSAUT1 + 1
  826. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IB))
  827. 5211 CONTINUE
  828. ELSE
  829. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  830. DO 5311 IA = IDEB,IFIN
  831. IB = (IA-1) / NSAUT2 + 1
  832. XVAL2(IA)= XINV * ATAN2(XVAL0(IB),XVAL1(IA))
  833. 5311 CONTINUE
  834. ENDIF
  835. RETURN
  836.  
  837. END
  838.  
  839.  
  840.  

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