Télécharger optabj.eso

Retour à la liste

Numérotation des lignes :

  1. C OPTABJ SOURCE CB215821 18/06/07 09:10:12 9835
  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 Decoupage pour le travail d''ecriture en parallele
  86. NNC = MAX(NN0,NN1,NN2)
  87. IRES = MOD(NNC,NBTHR)
  88. IF (IRES .EQ. 0) THEN
  89. ILON = NNC / NBTHR
  90. IDEB = (ithr -1)* ILON + 1
  91. ELSE
  92. IF (ithr .LE. IRES) THEN
  93. ILON = (NNC / NBTHR) + 1
  94. IDEB = (ithr -1)* ILON + 1
  95. ELSE
  96. ILON = NNC / NBTHR
  97. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  98. ENDIF
  99. ENDIF
  100. IFIN = IDEB + ILON - 1
  101.  
  102. IF (NTABEN .EQ. 2) GOTO 5000
  103.  
  104. C======================================================================C
  105. C OPERATIONS ENTRE UN TABLEAU ET UN FLOTTANT / ENTIER
  106. C======================================================================C
  107. IF (IARG2 .EQ. 1 .OR. IARG2 .EQ. 11) THEN
  108. X2 = REAL(I1I)
  109. ELSEIF(IARG2 .NE. 0 .AND. IARG2 .NE. 2 .AND. IARG2 .NE. 21) THEN
  110. C Surveillance de la validite des PARAMETRES d'entree
  111. IRETOU = 21
  112. RETURN
  113. ENDIF
  114.  
  115. C PRINT *, 'OPTABJ',ITHR,IOPE,NN0
  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,23 ),IOPE
  118. C Erreur si l''operation demandee n''est pas dans la liste
  119. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 213
  223. RETURN
  224. ELSEIF (XVAL0(IA) .LT. REAL(0.D0)) THEN
  225. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 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. IRETOU = 21
  595. RETURN
  596. ENDIF
  597. 2201 CONTINUE
  598. RETURN
  599.  
  600. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  601. C SIGN
  602. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  603. 23 CONTINUE
  604. DO 2301 IA = IDEB,IFIN
  605. XVAL2(IA)= SIGN(UN,XVAL0(IA))
  606. 2301 CONTINUE
  607. RETURN
  608.  
  609.  
  610.  
  611.  
  612. C======================================================================C
  613. C OPERATIONS TERMES A TERMES DE 2 TABLEAUX
  614. C======================================================================C
  615. 5000 CONTINUE
  616. NSAUT1 = NN0/NN1
  617. NSAUT2 = NN1/NN0
  618. GOTO ( 5001,5002,5003,5004,5005,9999,9999,9999,9999,9999,5011 ),
  619. & IOPE
  620. C Erreur si l''operation demandee n''est pas dans la liste
  621. 9999 CONTINUE
  622. IRETOU = 21
  623. RETURN
  624.  
  625. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  626. C PUISSANCE
  627. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  628. 5001 CONTINUE
  629. IF (NN0 .EQ. NN1 ) THEN
  630. C OPERATION TERME A TERME
  631. DO 5101 IA = IDEB,IFIN
  632. XFLO = XVAL0(IA)
  633. X2 = XVAL1(IA)
  634. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  635. & (XFLO .LT. REAL(0.D0))) THEN
  636. IRETOU = 213
  637. RETURN
  638. ELSE
  639. I2 = NINT(X2)
  640. XFLOT1 = ABS(X2 - REAL(I2))
  641. XFLOT = ABS(X2 - REAL(0.5D0))
  642. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  643. C PUISSANCE ENTIERE
  644. XVAL2(IA)= XFLO ** I2
  645. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  646. C RACINE CARREE SQRT
  647. XVAL2(IA)= SQRT(XFLO)
  648. ELSE
  649. C CAS GENERAL
  650. XVAL2(IA)= XFLO ** X2
  651. ENDIF
  652. ENDIF
  653. 5101 CONTINUE
  654. ELSEIF(NN0 .GT. NN1) THEN
  655. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  656. DO 5201 IA = IDEB,IFIN
  657. IB = (IA-1) / NSAUT1 + 1
  658. XFLO = XVAL0(IB)
  659. X2 = XVAL1(IA)
  660. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  661. & (XFLO .LT. REAL(0.D0))) THEN
  662. IRETOU = 213
  663. RETURN
  664. ELSE
  665. I2 = NINT(X2)
  666. XFLOT1 = ABS(X2 - REAL(I2))
  667. XFLOT = ABS(X2 - REAL(0.5D0))
  668. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  669. C PUISSANCE ENTIERE
  670. XVAL2(IA)= XFLO ** I2
  671. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  672. C RACINE CARREE SQRT
  673. XVAL2(IA)= SQRT(XFLO)
  674. ELSE
  675. C CAS GENERAL
  676. XVAL2(IA)= XFLO ** X2
  677. ENDIF
  678. ENDIF
  679. 5201 CONTINUE
  680. ELSE
  681. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  682. DO 5301 IA = IDEB,IFIN
  683. IB = (IA-1) / NSAUT2 + 1
  684. XFLO = XVAL0(IA)
  685. X2 = XVAL1(IB)
  686. IF ( ((ABS(XFLO) .LE. XPETIT) .AND. (X2 .LT. REAL(0.D0))) .OR.
  687. & (XFLO .LT. REAL(0.D0))) THEN
  688. IRETOU = 213
  689. RETURN
  690. ELSE
  691. I2 = NINT(X2)
  692. XFLOT1 = ABS(X2 - REAL(I2))
  693. XFLOT = ABS(X2 - REAL(0.5D0))
  694. IF ( XFLOT1 .LE. (XZPREC*ABS(X2)*REAL(2.D0))) THEN
  695. C PUISSANCE ENTIERE
  696. XVAL2(IA)= XFLO ** I2
  697. ELSEIF (XFLOT .LE. (XZPREC*ABS(X2)*REAL(2.D0)) ) THEN
  698. C RACINE CARREE SQRT
  699. XVAL2(IA)= SQRT(XFLO)
  700. ELSE
  701. C CAS GENERAL
  702. XVAL2(IA)= XFLO ** X2
  703. ENDIF
  704. ENDIF
  705. 5301 CONTINUE
  706. ENDIF
  707. RETURN
  708.  
  709. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  710. C PRODUIT
  711. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  712. 5002 CONTINUE
  713. IF (NSAUT1 .EQ. 1 ) THEN
  714. C OPERATION TERME A TERME
  715. DO 5102 IA = IDEB,IFIN
  716. XVAL2(IA)= XVAL0(IA) * XVAL1(IA)
  717. 5102 CONTINUE
  718. ELSEIF(NSAUT1 .GT. 0 ) THEN
  719. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  720. DO 5202 IA = IDEB,IFIN
  721. IB = (IA-1) / NSAUT1 + 1
  722. XVAL2(IA)= XVAL0(IA) * XVAL1(IB)
  723. 5202 CONTINUE
  724. ELSE
  725. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  726. DO 5302 IA = IDEB,IFIN
  727. IB = (IA-1) / NSAUT2 + 1
  728. XVAL2(IA)= XVAL0(IB) * XVAL1(IA)
  729. 5302 CONTINUE
  730. ENDIF
  731. RETURN
  732.  
  733. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  734. C ADDITION
  735. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  736. 5003 CONTINUE
  737. IF (NSAUT1 .EQ. 1 ) THEN
  738. C OPERATION TERME A TERME
  739. DO 5103 IA=IDEB,IFIN
  740. XVAL2(IA) = XVAL0(IA) + XVAL1(IA)
  741. 5103 CONTINUE
  742. ELSEIF(NSAUT1 .GT. 0 ) THEN
  743. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  744. DO 5203 IA=IDEB,IFIN
  745. IB = (IA-1) / NSAUT1 + 1
  746. XVAL2(IA) = XVAL0(IA) + XVAL1(IB)
  747. 5203 CONTINUE
  748. ELSE
  749. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  750. DO 5303 IA=IDEB,IFIN
  751. IB = (IA-1) / NSAUT2 + 1
  752. XVAL2(IA) = XVAL0(IB) + XVAL1(IA)
  753. 5303 CONTINUE
  754. ENDIF
  755. RETURN
  756.  
  757. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  758. C SOUSTRACTION
  759. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  760. 5004 CONTINUE
  761. IF (NSAUT1 .EQ. 1 ) THEN
  762. C OPERATION TERME A TERME
  763. DO 5104 IA = IDEB,IFIN
  764. XVAL2(IA)= XVAL0(IA) - XVAL1(IA)
  765. 5104 CONTINUE
  766. ELSEIF(NSAUT1 .GT. 0 ) THEN
  767. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  768. DO 5204 IA = IDEB,IFIN
  769. IB = (IA-1) / NSAUT1 + 1
  770. XVAL2(IA)= XVAL0(IA) - XVAL1(IB)
  771. 5204 CONTINUE
  772. ELSE
  773. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  774. DO 5304 IA = IDEB,IFIN
  775. IB = (IA-1) / NSAUT2 + 1
  776. XVAL2(IA)= XVAL0(IB) - XVAL1(IA)
  777. 5304 CONTINUE
  778. ENDIF
  779. RETURN
  780.  
  781. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  782. C DIVISION
  783. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  784. 5005 CONTINUE
  785. IF (NSAUT1 .EQ. 1 ) THEN
  786. C OPERATION TERME A TERME
  787. DO 5105 IA = IDEB,IFIN
  788. X2 = XVAL1(IA)
  789. IF (ABS(X2) .GT. XPETIT) THEN
  790. XVAL2(IA)= XVAL0(IA) / X2
  791. ELSE
  792. IRETOU = 835
  793. RETURN
  794. ENDIF
  795. 5105 CONTINUE
  796. ELSEIF(NSAUT1 .GT. 0 ) THEN
  797. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  798. DO 5205 IA = IDEB,IFIN
  799. IB = (IA-1) / NSAUT1 + 1
  800. X2 = XVAL1(IB)
  801. IF (ABS(X2) .GT. XPETIT) THEN
  802. XVAL2(IA)= XVAL0(IA) / X2
  803. ELSE
  804. IRETOU = 835
  805. RETURN
  806. ENDIF
  807. 5205 CONTINUE
  808. ELSE
  809. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  810. DO 5305 IA = IDEB,IFIN
  811. IB = (IA-1) / NSAUT2 + 1
  812. X2 = XVAL1(IA)
  813. IF (ABS(X2) .GT. XPETIT) THEN
  814. XVAL2(IA)= XVAL0(IB) / X2
  815. ELSE
  816. IRETOU = 835
  817. RETURN
  818. ENDIF
  819. 5305 CONTINUE
  820. ENDIF
  821. RETURN
  822.  
  823. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  824. C ARCTANGENTE
  825. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  826. 5011 CONTINUE
  827. IF (NSAUT1 .EQ. 1 ) THEN
  828. C OPERATION TERME A TERME
  829. DO 5111 IA = IDEB,IFIN
  830. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IA))
  831. 5111 CONTINUE
  832. ELSEIF(NSAUT1 .GT. 0 ) THEN
  833. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT1 POUR LE TABLEAU 2
  834. DO 5211 IA = IDEB,IFIN
  835. IB = (IA-1) / NSAUT1 + 1
  836. XVAL2(IA)= XINV * ATAN2(XVAL0(IA),XVAL1(IB))
  837. 5211 CONTINUE
  838. ELSE
  839. C OPERATION EN AVANCANT 1 FOIS SUR NSAUT2 POUR LE TABLEAU 1
  840. DO 5311 IA = IDEB,IFIN
  841. IB = (IA-1) / NSAUT2 + 1
  842. XVAL2(IA)= XINV * ATAN2(XVAL0(IB),XVAL1(IA))
  843. 5311 CONTINUE
  844. ENDIF
  845. RETURN
  846.  
  847. END
  848.  
  849.  
  850.  
  851.  
  852.  
  853.  
  854.  

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