Télécharger opchpi.eso

Retour à la liste

Numérotation des lignes :

  1. C OPCHPI SOURCE CB215821 16/06/16 10:38:32 8972
  2.  
  3. SUBROUTINE OPCHPi(ithr)
  4. C Cette subroutine est l'interface de calcul sur les CHPOINTS
  5. C Elle peut etre appelee en parallele
  6.  
  7.  
  8. C Creation 07/12/2015
  9. C Createur CB215821
  10. C Historique des Corrections apportees :
  11. C -
  12. C -
  13. C -
  14.  
  15. C Elle realise les operations suivantes :
  16.  
  17. C IOPE = 1 PUISSANCE
  18. C = 2 PRODUIT
  19. C = 3 ADDITION
  20. C = 4 SOUSTRACTION
  21. C = 5 DIVISION
  22. C = 6 COSINUS
  23. C = 7 SINUS
  24. C = 8 TANGENTE
  25. C = 9 ARCOSINUS
  26. C = 10 ARCSINUS
  27. C = 11 ARCTANGENTE
  28. C = 12 EXPONENTIELLE
  29. C = 13 LOGARITHME
  30. C = 14 VALEUR ABSOLUE
  31. C = 15 COSINUS HYPERBOLIQUE
  32. C = 16 SINUS HYPERBOLIQUE
  33. C = 17 TANGENTE HYPERBOLIQUE
  34. C = 18 ERF FONCTION D'ERRREUR DE GAUSS
  35. C = 19 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
  36. C = 20 ARGCH (Fonction reciproque de COSH)
  37. C = 21 ARGSH (Fonction reciproque de SINH)
  38. C = 22 ARGTH (Fonction reciproque de TANH)
  39.  
  40. C IARG = 0 ==> ARGUMENT I1I et X1I INUTILISES
  41. C IARG = 1 ==> ARGUMENT I1I UTILISE
  42. C IARG = 2 ==> ARGUMENT X1I UTILISE
  43.  
  44. IMPLICIT INTEGER(I-N)
  45. IMPLICIT REAL*8 (A-H,O-Z)
  46.  
  47. -INC CCOPTIO
  48. -INC SMCHPOI
  49. -INC CCREEL
  50.  
  51. C Declaration du COMMON pour le travail en parallele
  52. COMMON/opchpc/NBTHR,IPOIN,IPOIN1,IERR1,NSOUPO,IOPE,IARG,I1I,X1I
  53.  
  54. SEGMENT SERROR
  55. LOGICAL BERROR(NBTHR)
  56. ENDSEGMENT
  57.  
  58. MCHPOI = IPOIN
  59. MCHPO1 = IPOIN1
  60. SERROR = IERR1
  61.  
  62. I2 = I1I
  63. IARG2=IARG
  64.  
  65. GOTO ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,
  66. & 18,19,20,21,22 ),IOPE
  67. C Erreur si l'operation demandee n'est pas encore possible
  68. CALL ERREUR(21)
  69. RETURN
  70.  
  71. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  72. C PUISSANCE
  73. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  74. 1 CONTINUE
  75. IF (IARG2 .EQ. 1) THEN
  76. C PUISSANCE ENTIERE
  77.  
  78. DO 101 IA=1,NSOUPO
  79. MSOUPO=MCHPOI.IPCHP(IA)
  80. MSOUP1=MCHPO1.IPCHP(IA)
  81. MPOVAL=MSOUPO.IPOVAL
  82. MPOVA1=MSOUP1.IPOVAL
  83. N =MPOVAL.VPOCHA(/1)
  84. NC=MPOVAL.VPOCHA(/2)
  85.  
  86. IRES = MOD(N,NBTHR)
  87. IF (IRES .EQ. 0) THEN
  88. ILON = N / NBTHR
  89. IDEB = (ithr -1)* ILON + 1
  90. ELSE
  91. IF (ithr .LE. IRES) THEN
  92. ILON = (N / NBTHR) + 1
  93. IDEB = (ithr -1)* ILON + 1
  94. ELSE
  95. ILON = N / NBTHR
  96. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  97. ENDIF
  98. ENDIF
  99. IFIN = IDEB + ILON - 1
  100. DO 101 IC=1,NC
  101. DO 101 IB = IDEB,IFIN
  102. XTRA=MPOVA1.VPOCHA(IB,IC)
  103. IF(ABS(XTRA).LT.XPETIT .AND. I2.LT.0)THEN
  104. SERROR.BERROR(ithr) = .TRUE.
  105. RETURN
  106. ELSE
  107. MPOVAL.VPOCHA(IB,IC)=XTRA ** I2
  108. ENDIF
  109. 101 CONTINUE
  110. RETURN
  111.  
  112. ELSE
  113. C PUISSANCE FLOTTANT
  114. C Verification si puissance ENTIERE possible
  115. I2 = NINT(X1I)
  116. XFLOT = ABS(X1I - REAL(I2))
  117.  
  118. IF ( XFLOT .LE. (XZPREC*ABS(X1I)*REAL(2.D0))) THEN
  119. IARG2=1
  120. GOTO 1
  121. ENDIF
  122.  
  123. C Verification si SQRT possible
  124. XFLOT = ABS(X1I - REAL(0.5D0))
  125. IF (XFLOT .LE. (XZPREC*ABS(X1I)*REAL(2.D0))) THEN
  126. C RACINE CARREE
  127. DO 102 IA=1,NSOUPO
  128. MSOUPO=MCHPOI.IPCHP(IA)
  129. MSOUP1=MCHPO1.IPCHP(IA)
  130. MPOVAL=MSOUPO.IPOVAL
  131. MPOVA1=MSOUP1.IPOVAL
  132. N =MPOVAL.VPOCHA(/1)
  133. NC=MPOVAL.VPOCHA(/2)
  134.  
  135. IRES = MOD(N,NBTHR)
  136. IF (IRES .EQ. 0) THEN
  137. ILON = N / NBTHR
  138. IDEB = (ithr -1)* ILON + 1
  139. ELSE
  140. IF (ithr .LE. IRES) THEN
  141. ILON = (N / NBTHR) + 1
  142. IDEB = (ithr -1)* ILON + 1
  143. ELSE
  144. ILON = N / NBTHR
  145. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  146. ENDIF
  147. ENDIF
  148. IFIN = IDEB + ILON - 1
  149. DO 102 IC=1,NC
  150. DO 102 IB = IDEB,IFIN
  151. XFLO = MPOVA1.VPOCHA(IB,IC)
  152. IF (XFLO .LT. REAL(0.D0)) THEN
  153. SERROR.BERROR(ithr) = .TRUE.
  154. RETURN
  155. ELSE
  156. MPOVAL.VPOCHA(IB,IC)=SQRT(MPOVA1.VPOCHA(IB,IC))
  157. ENDIF
  158. 102 CONTINUE
  159. RETURN
  160. ELSE
  161. C CAS GENERAL
  162. DO 103 IA=1,NSOUPO
  163. MSOUPO=MCHPOI.IPCHP(IA)
  164. MSOUP1=MCHPO1.IPCHP(IA)
  165. MPOVAL=MSOUPO.IPOVAL
  166. MPOVA1=MSOUP1.IPOVAL
  167. N =MPOVAL.VPOCHA(/1)
  168. NC=MPOVAL.VPOCHA(/2)
  169.  
  170. IRES = MOD(N,NBTHR)
  171. IF (IRES .EQ. 0) THEN
  172. ILON = N / NBTHR
  173. IDEB = (ithr -1)* ILON + 1
  174. ELSE
  175. IF (ithr .LE. IRES) THEN
  176. ILON = (N / NBTHR) + 1
  177. IDEB = (ithr -1)* ILON + 1
  178. ELSE
  179. ILON = N / NBTHR
  180. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  181. ENDIF
  182. ENDIF
  183. IFIN = IDEB + ILON - 1
  184. DO 103 IC=1,NC
  185. DO 103 IB = IDEB,IFIN
  186. XFLO = MPOVA1.VPOCHA(IB,IC)
  187. IF ((ABS(XFLO) .LE. XPETIT) .AND.
  188. & (X1I.LT. REAL(0.D0))) THEN
  189. SERROR.BERROR(ithr) = .TRUE.
  190. RETURN
  191. ELSEIF (XFLO .LT. REAL(0.D0)) THEN
  192. SERROR.BERROR(ithr) = .TRUE.
  193. RETURN
  194. ELSE
  195. MPOVAL.VPOCHA(IB,IC)=XFLO ** X1I
  196. ENDIF
  197. 103 CONTINUE
  198. RETURN
  199. ENDIF
  200. ENDIF
  201.  
  202. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  203. C PRODUIT
  204. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  205. 2 CONTINUE
  206. C DANS LE CAS *0. ON SORT DIRECT CAR VPOCHA A SEULEMENT ETE SEGINI
  207. IF (ABS(X1I) .LE. XPETIT) RETURN
  208. DO 201 IA=1,NSOUPO
  209. MSOUPO=MCHPOI.IPCHP(IA)
  210. MSOUP1=MCHPO1.IPCHP(IA)
  211. MPOVAL=MSOUPO.IPOVAL
  212. MPOVA1=MSOUP1.IPOVAL
  213. N =MPOVAL.VPOCHA(/1)
  214. NC=MPOVAL.VPOCHA(/2)
  215.  
  216. IRES = MOD(N,NBTHR)
  217. IF (IRES .EQ. 0) THEN
  218. ILON = N / NBTHR
  219. IDEB = (ithr -1)* ILON + 1
  220. ELSE
  221. IF (ithr .LE. IRES) THEN
  222. ILON = (N / NBTHR) + 1
  223. IDEB = (ithr -1)* ILON + 1
  224. ELSE
  225. ILON = N / NBTHR
  226. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  227. ENDIF
  228. ENDIF
  229. IFIN = IDEB + ILON - 1
  230. DO 201 IC=1,NC
  231. DO 201 IB = IDEB,IFIN
  232. MPOVAL.VPOCHA(IB,IC)=MPOVA1.VPOCHA(IB,IC) * X1I
  233. 201 CONTINUE
  234. RETURN
  235.  
  236. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  237. C ADDITION
  238. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  239. 3 CONTINUE
  240. DO 301 IA=1,NSOUPO
  241. MSOUPO=MCHPOI.IPCHP(IA)
  242. MSOUP1=MCHPO1.IPCHP(IA)
  243. MPOVAL=MSOUPO.IPOVAL
  244. MPOVA1=MSOUP1.IPOVAL
  245. N =MPOVAL.VPOCHA(/1)
  246. NC=MPOVAL.VPOCHA(/2)
  247.  
  248.  
  249. IRES = MOD(N,NBTHR)
  250. IF (IRES .EQ. 0) THEN
  251. ILON = N / NBTHR
  252. IDEB = (ithr -1)* ILON + 1
  253. ELSE
  254. IF (ithr .LE. IRES) THEN
  255. ILON = (N / NBTHR) + 1
  256. IDEB = (ithr -1)* ILON + 1
  257. ELSE
  258. ILON = N / NBTHR
  259. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  260. ENDIF
  261. ENDIF
  262. IFIN = IDEB + ILON - 1
  263. DO 301 IC=1,NC
  264. DO 301 IB = IDEB,IFIN
  265. MPOVAL.VPOCHA(IB,IC)=MPOVA1.VPOCHA(IB,IC) + X1I
  266. 301 CONTINUE
  267. RETURN
  268.  
  269. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  270. C SOUSTRACTION
  271. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  272. 4 CONTINUE
  273. DO 401 IA=1,NSOUPO
  274. MSOUPO=MCHPOI.IPCHP(IA)
  275. MSOUP1=MCHPO1.IPCHP(IA)
  276. MPOVAL=MSOUPO.IPOVAL
  277. MPOVA1=MSOUP1.IPOVAL
  278. N =MPOVAL.VPOCHA(/1)
  279. NC=MPOVAL.VPOCHA(/2)
  280.  
  281. IRES = MOD(N,NBTHR)
  282. IF (IRES .EQ. 0) THEN
  283. ILON = N / NBTHR
  284. IDEB = (ithr -1)* ILON + 1
  285. ELSE
  286. IF (ithr .LE. IRES) THEN
  287. ILON = (N / NBTHR) + 1
  288. IDEB = (ithr -1)* ILON + 1
  289. ELSE
  290. ILON = N / NBTHR
  291. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  292. ENDIF
  293. ENDIF
  294. IFIN = IDEB + ILON - 1
  295. IF (I1I .EQ. 1) THEN
  296. C Cas CHP1 - FLO1
  297. DO 402 IC=1,NC
  298. DO 402 IB = IDEB,IFIN
  299. MPOVAL.VPOCHA(IB,IC)=MPOVA1.VPOCHA(IB,IC) - X1I
  300. 402 CONTINUE
  301. ELSE
  302. C Cas FLO1 - CHP1
  303. DO 403 IC=1,NC
  304. DO 403 IB = IDEB,IFIN
  305. MPOVAL.VPOCHA(IB,IC)=X1I - MPOVA1.VPOCHA(IB,IC)
  306. 403 CONTINUE
  307. ENDIF
  308. 401 CONTINUE
  309. RETURN
  310.  
  311. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  312. C DIVISION
  313. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  314. 5 CONTINUE
  315. DO 501 IA=1,NSOUPO
  316. MSOUPO=MCHPOI.IPCHP(IA)
  317. MSOUP1=MCHPO1.IPCHP(IA)
  318. MPOVAL=MSOUPO.IPOVAL
  319. MPOVA1=MSOUP1.IPOVAL
  320. N =MPOVAL.VPOCHA(/1)
  321. NC=MPOVAL.VPOCHA(/2)
  322. IRES = MOD(N,NBTHR)
  323. IF (IRES .EQ. 0) THEN
  324. ILON = N / NBTHR
  325. IDEB = (ithr -1)* ILON + 1
  326. ELSE
  327. IF (ithr .LE. IRES) THEN
  328. ILON = (N / NBTHR) + 1
  329. IDEB = (ithr -1)* ILON + 1
  330. ELSE
  331. ILON = N / NBTHR
  332. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  333. ENDIF
  334. ENDIF
  335. IFIN = IDEB + ILON - 1
  336. DO 501 IC=1,NC
  337. DO 501 IB = IDEB,IFIN
  338. IF (ABS(X1I) .GT. XPETIT) THEN
  339. MPOVAL.VPOCHA(IB,IC)=MPOVA1.VPOCHA(IB,IC) / X1I
  340. ELSE
  341. SERROR.BERROR(ithr) = .TRUE.
  342. RETURN
  343. ENDIF
  344. 501 CONTINUE
  345. RETURN
  346.  
  347.  
  348. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  349. C COSINUS
  350. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  351. 6 CONTINUE
  352. XVNOC = XPI / REAL(180.D0)
  353. DO 601 IA=1,NSOUPO
  354. MSOUPO=MCHPOI.IPCHP(IA)
  355. MSOUP1=MCHPO1.IPCHP(IA)
  356. MPOVAL=MSOUPO.IPOVAL
  357. MPOVA1=MSOUP1.IPOVAL
  358. N =MPOVAL.VPOCHA(/1)
  359. NC=MPOVAL.VPOCHA(/2)
  360. IRES = MOD(N,NBTHR)
  361. IF (IRES .EQ. 0) THEN
  362. ILON = N / NBTHR
  363. IDEB = (ithr -1)* ILON + 1
  364. ELSE
  365. IF (ithr .LE. IRES) THEN
  366. ILON = (N / NBTHR) + 1
  367. IDEB = (ithr -1)* ILON + 1
  368. ELSE
  369. ILON = N / NBTHR
  370. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  371. ENDIF
  372. ENDIF
  373. IFIN = IDEB + ILON - 1
  374. DO 601 IC=1,NC
  375. DO 601 IB = IDEB,IFIN
  376. MPOVAL.VPOCHA(IB,IC)=COS(XVNOC * MPOVA1.VPOCHA(IB,IC))
  377. 601 CONTINUE
  378. RETURN
  379.  
  380.  
  381. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  382. C SINUS
  383. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  384. 7 CONTINUE
  385. XVNOC = XPI / REAL(180.D0)
  386. DO 701 IA=1,NSOUPO
  387. MSOUPO=MCHPOI.IPCHP(IA)
  388. MSOUP1=MCHPO1.IPCHP(IA)
  389. MPOVAL=MSOUPO.IPOVAL
  390. MPOVA1=MSOUP1.IPOVAL
  391. N =MPOVAL.VPOCHA(/1)
  392. NC=MPOVAL.VPOCHA(/2)
  393. IRES = MOD(N,NBTHR)
  394. IF (IRES .EQ. 0) THEN
  395. ILON = N / NBTHR
  396. IDEB = (ithr -1)* ILON + 1
  397. ELSE
  398. IF (ithr .LE. IRES) THEN
  399. ILON = (N / NBTHR) + 1
  400. IDEB = (ithr -1)* ILON + 1
  401. ELSE
  402. ILON = N / NBTHR
  403. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  404. ENDIF
  405. ENDIF
  406. IFIN = IDEB + ILON - 1
  407. DO 701 IC=1,NC
  408. DO 701 IB = IDEB,IFIN
  409. MPOVAL.VPOCHA(IB,IC)=SIN(XVNOC * MPOVA1.VPOCHA(IB,IC))
  410. 701 CONTINUE
  411. RETURN
  412.  
  413.  
  414. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  415. C TANGENTE
  416. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  417. 8 CONTINUE
  418. XVNOC = XPI / REAL(180.D0)
  419. DO 801 IA=1,NSOUPO
  420. MSOUPO=MCHPOI.IPCHP(IA)
  421. MSOUP1=MCHPO1.IPCHP(IA)
  422. MPOVAL=MSOUPO.IPOVAL
  423. MPOVA1=MSOUP1.IPOVAL
  424. N =MPOVAL.VPOCHA(/1)
  425. NC=MPOVAL.VPOCHA(/2)
  426. IRES = MOD(N,NBTHR)
  427. IF (IRES .EQ. 0) THEN
  428. ILON = N / NBTHR
  429. IDEB = (ithr -1)* ILON + 1
  430. ELSE
  431. IF (ithr .LE. IRES) THEN
  432. ILON = (N / NBTHR) + 1
  433. IDEB = (ithr -1)* ILON + 1
  434. ELSE
  435. ILON = N / NBTHR
  436. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  437. ENDIF
  438. ENDIF
  439. IFIN = IDEB + ILON - 1
  440. DO 801 IC=1,NC
  441. DO 801 IB = IDEB,IFIN
  442. MPOVAL.VPOCHA(IB,IC)=TAN(XVNOC * MPOVA1.VPOCHA(IB,IC))
  443. 801 CONTINUE
  444. RETURN
  445.  
  446.  
  447. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  448. C ARCCOS
  449. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  450. 9 CONTINUE
  451. XVNOC = REAL(180.D0) / XPI
  452. DO 901 IA=1,NSOUPO
  453. MSOUPO=MCHPOI.IPCHP(IA)
  454. MSOUP1=MCHPO1.IPCHP(IA)
  455. MPOVAL=MSOUPO.IPOVAL
  456. MPOVA1=MSOUP1.IPOVAL
  457. N =MPOVAL.VPOCHA(/1)
  458. NC=MPOVAL.VPOCHA(/2)
  459. IRES = MOD(N,NBTHR)
  460. IF (IRES .EQ. 0) THEN
  461. ILON = N / NBTHR
  462. IDEB = (ithr -1)* ILON + 1
  463. ELSE
  464. IF (ithr .LE. IRES) THEN
  465. ILON = (N / NBTHR) + 1
  466. IDEB = (ithr -1)* ILON + 1
  467. ELSE
  468. ILON = N / NBTHR
  469. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  470. ENDIF
  471. ENDIF
  472. IFIN = IDEB + ILON - 1
  473. DO 901 IC=1,NC
  474. DO 901 IB = IDEB,IFIN
  475. X2 = MPOVA1.VPOCHA(IB,IC)
  476. IF ((X2 .GE. -1.) .AND. (X2 .LE. 1.)) THEN
  477. MPOVAL.VPOCHA(IB,IC)=XVNOC * ACOS(X2)
  478. ELSE
  479. SERROR.BERROR(ithr) = .TRUE.
  480. RETURN
  481. ENDIF
  482. 901 CONTINUE
  483. RETURN
  484.  
  485.  
  486. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  487. C ARCSIN
  488. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  489. 10 CONTINUE
  490. XVNOC = REAL(180.D0) / XPI
  491. DO 1001 IA=1,NSOUPO
  492. MSOUPO=MCHPOI.IPCHP(IA)
  493. MSOUP1=MCHPO1.IPCHP(IA)
  494. MPOVAL=MSOUPO.IPOVAL
  495. MPOVA1=MSOUP1.IPOVAL
  496. N =MPOVAL.VPOCHA(/1)
  497. NC=MPOVAL.VPOCHA(/2)
  498. IRES = MOD(N,NBTHR)
  499. IF (IRES .EQ. 0) THEN
  500. ILON = N / NBTHR
  501. IDEB = (ithr -1)* ILON + 1
  502. ELSE
  503. IF (ithr .LE. IRES) THEN
  504. ILON = (N / NBTHR) + 1
  505. IDEB = (ithr -1)* ILON + 1
  506. ELSE
  507. ILON = N / NBTHR
  508. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  509. ENDIF
  510. ENDIF
  511. IFIN = IDEB + ILON - 1
  512. DO 1001 IC=1,NC
  513. DO 1001 IB = IDEB,IFIN
  514. X2 = MPOVA1.VPOCHA(IB,IC)
  515. IF ((X2 .GE. -1.) .AND. (X2 .LE. 1.)) THEN
  516. MPOVAL.VPOCHA(IB,IC)=XVNOC * ASIN(X2)
  517. ELSE
  518. SERROR.BERROR(ithr) = .TRUE.
  519. RETURN
  520. ENDIF
  521. 1001 CONTINUE
  522. RETURN
  523.  
  524.  
  525. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  526. C ARCTAN
  527. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  528. 11 CONTINUE
  529. XVNOC = REAL(180.D0) / XPI
  530. DO 1101 IA=1,NSOUPO
  531. MSOUPO=MCHPOI.IPCHP(IA)
  532. MSOUP1=MCHPO1.IPCHP(IA)
  533. MPOVAL=MSOUPO.IPOVAL
  534. MPOVA1=MSOUP1.IPOVAL
  535. N =MPOVAL.VPOCHA(/1)
  536. NC=MPOVAL.VPOCHA(/2)
  537. IRES = MOD(N,NBTHR)
  538. IF (IRES .EQ. 0) THEN
  539. ILON = N / NBTHR
  540. IDEB = (ithr -1)* ILON + 1
  541. ELSE
  542. IF (ithr .LE. IRES) THEN
  543. ILON = (N / NBTHR) + 1
  544. IDEB = (ithr -1)* ILON + 1
  545. ELSE
  546. ILON = N / NBTHR
  547. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  548. ENDIF
  549. ENDIF
  550. IFIN = IDEB + ILON - 1
  551. DO 1101 IC=1,NC
  552. DO 1101 IB = IDEB,IFIN
  553. MPOVAL.VPOCHA(IB,IC)=XVNOC * ATAN(MPOVA1.VPOCHA(IB,IC))
  554. 1101 CONTINUE
  555. RETURN
  556.  
  557.  
  558. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  559. C EXPONENTIELLE
  560. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  561. 12 CONTINUE
  562. DO 1201 IA=1,NSOUPO
  563. MSOUPO=MCHPOI.IPCHP(IA)
  564. MSOUP1=MCHPO1.IPCHP(IA)
  565. MPOVAL=MSOUPO.IPOVAL
  566. MPOVA1=MSOUP1.IPOVAL
  567. N =MPOVAL.VPOCHA(/1)
  568. NC=MPOVAL.VPOCHA(/2)
  569. IRES = MOD(N,NBTHR)
  570. IF (IRES .EQ. 0) THEN
  571. ILON = N / NBTHR
  572. IDEB = (ithr -1)* ILON + 1
  573. ELSE
  574. IF (ithr .LE. IRES) THEN
  575. ILON = (N / NBTHR) + 1
  576. IDEB = (ithr -1)* ILON + 1
  577. ELSE
  578. ILON = N / NBTHR
  579. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  580. ENDIF
  581. ENDIF
  582. IFIN = IDEB + ILON - 1
  583. DO 1201 IC=1,NC
  584. DO 1201 IB = IDEB,IFIN
  585. MPOVAL.VPOCHA(IB,IC)=EXP(MPOVA1.VPOCHA(IB,IC))
  586. 1201 CONTINUE
  587. RETURN
  588.  
  589.  
  590. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  591. C LOGARITHME
  592. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  593. 13 CONTINUE
  594. DO 1301 IA=1,NSOUPO
  595. MSOUPO=MCHPOI.IPCHP(IA)
  596. MSOUP1=MCHPO1.IPCHP(IA)
  597. MPOVAL=MSOUPO.IPOVAL
  598. MPOVA1=MSOUP1.IPOVAL
  599. N =MPOVAL.VPOCHA(/1)
  600. NC=MPOVAL.VPOCHA(/2)
  601. IRES = MOD(N,NBTHR)
  602. IF (IRES .EQ. 0) THEN
  603. ILON = N / NBTHR
  604. IDEB = (ithr -1)* ILON + 1
  605. ELSE
  606. IF (ithr .LE. IRES) THEN
  607. ILON = (N / NBTHR) + 1
  608. IDEB = (ithr -1)* ILON + 1
  609. ELSE
  610. ILON = N / NBTHR
  611. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  612. ENDIF
  613. ENDIF
  614. IFIN = IDEB + ILON - 1
  615. DO 1301 IC=1,NC
  616. DO 1301 IB = IDEB,IFIN
  617. X2 = MPOVA1.VPOCHA(IB,IC)
  618. IF (X2 .GE. XPETIT) THEN
  619. MPOVAL.VPOCHA(IB,IC)=LOG(X2)
  620. ELSE
  621. SERROR.BERROR(ithr) = .TRUE.
  622. RETURN
  623. ENDIF
  624. 1301 CONTINUE
  625. RETURN
  626.  
  627.  
  628. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  629. C VALEUR ABSOLUE
  630. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  631. 14 CONTINUE
  632. DO 1401 IA=1,NSOUPO
  633. MSOUPO=MCHPOI.IPCHP(IA)
  634. MSOUP1=MCHPO1.IPCHP(IA)
  635. MPOVAL=MSOUPO.IPOVAL
  636. MPOVA1=MSOUP1.IPOVAL
  637. N =MPOVAL.VPOCHA(/1)
  638. NC=MPOVAL.VPOCHA(/2)
  639. IRES = MOD(N,NBTHR)
  640. IF (IRES .EQ. 0) THEN
  641. ILON = N / NBTHR
  642. IDEB = (ithr -1)* ILON + 1
  643. ELSE
  644. IF (ithr .LE. IRES) THEN
  645. ILON = (N / NBTHR) + 1
  646. IDEB = (ithr -1)* ILON + 1
  647. ELSE
  648. ILON = N / NBTHR
  649. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  650. ENDIF
  651. ENDIF
  652. IFIN = IDEB + ILON - 1
  653. DO 1401 IC=1,NC
  654. DO 1401 IB = IDEB,IFIN
  655. MPOVAL.VPOCHA(IB,IC)=ABS(MPOVA1.VPOCHA(IB,IC))
  656. 1401 CONTINUE
  657. RETURN
  658.  
  659.  
  660. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  661. C COSINUS HYPERBOLIQUE
  662. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  663. 15 CONTINUE
  664. DO 1501 IA=1,NSOUPO
  665. MSOUPO=MCHPOI.IPCHP(IA)
  666. MSOUP1=MCHPO1.IPCHP(IA)
  667. MPOVAL=MSOUPO.IPOVAL
  668. MPOVA1=MSOUP1.IPOVAL
  669. N =MPOVAL.VPOCHA(/1)
  670. NC=MPOVAL.VPOCHA(/2)
  671. IRES = MOD(N,NBTHR)
  672. IF (IRES .EQ. 0) THEN
  673. ILON = N / NBTHR
  674. IDEB = (ithr -1)* ILON + 1
  675. ELSE
  676. IF (ithr .LE. IRES) THEN
  677. ILON = (N / NBTHR) + 1
  678. IDEB = (ithr -1)* ILON + 1
  679. ELSE
  680. ILON = N / NBTHR
  681. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  682. ENDIF
  683. ENDIF
  684. IFIN = IDEB + ILON - 1
  685. DO 1501 IC=1,NC
  686. DO 1501 IB = IDEB,IFIN
  687. MPOVAL.VPOCHA(IB,IC)=COSH(MPOVA1.VPOCHA(IB,IC))
  688. 1501 CONTINUE
  689. RETURN
  690.  
  691.  
  692. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  693. C SINUS HYPERBOLIQUE
  694. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  695. 16 CONTINUE
  696. DO 1601 IA=1,NSOUPO
  697. MSOUPO=MCHPOI.IPCHP(IA)
  698. MSOUP1=MCHPO1.IPCHP(IA)
  699. MPOVAL=MSOUPO.IPOVAL
  700. MPOVA1=MSOUP1.IPOVAL
  701. N =MPOVAL.VPOCHA(/1)
  702. NC=MPOVAL.VPOCHA(/2)
  703. IRES = MOD(N,NBTHR)
  704. IF (IRES .EQ. 0) THEN
  705. ILON = N / NBTHR
  706. IDEB = (ithr -1)* ILON + 1
  707. ELSE
  708. IF (ithr .LE. IRES) THEN
  709. ILON = (N / NBTHR) + 1
  710. IDEB = (ithr -1)* ILON + 1
  711. ELSE
  712. ILON = N / NBTHR
  713. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  714. ENDIF
  715. ENDIF
  716. IFIN = IDEB + ILON - 1
  717. DO 1601 IC=1,NC
  718. DO 1601 IB = IDEB,IFIN
  719. MPOVAL.VPOCHA(IB,IC)=SINH(MPOVA1.VPOCHA(IB,IC))
  720. 1601 CONTINUE
  721. RETURN
  722.  
  723.  
  724. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  725. C TANGENTE HYPERBOLIQUE
  726. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  727. 17 CONTINUE
  728. DO 1701 IA=1,NSOUPO
  729. MSOUPO=MCHPOI.IPCHP(IA)
  730. MSOUP1=MCHPO1.IPCHP(IA)
  731. MPOVAL=MSOUPO.IPOVAL
  732. MPOVA1=MSOUP1.IPOVAL
  733. N =MPOVAL.VPOCHA(/1)
  734. NC=MPOVAL.VPOCHA(/2)
  735. IRES = MOD(N,NBTHR)
  736. IF (IRES .EQ. 0) THEN
  737. ILON = N / NBTHR
  738. IDEB = (ithr -1)* ILON + 1
  739. ELSE
  740. IF (ithr .LE. IRES) THEN
  741. ILON = (N / NBTHR) + 1
  742. IDEB = (ithr -1)* ILON + 1
  743. ELSE
  744. ILON = N / NBTHR
  745. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  746. ENDIF
  747. ENDIF
  748. IFIN = IDEB + ILON - 1
  749. DO 1701 IC=1,NC
  750. DO 1701 IB = IDEB,IFIN
  751. MPOVAL.VPOCHA(IB,IC)=TANH(MPOVA1.VPOCHA(IB,IC))
  752. 1701 CONTINUE
  753. RETURN
  754.  
  755.  
  756. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  757. C ERF (Fonction Erreur)
  758. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  759. 18 CONTINUE
  760. DO 1801 IA=1,NSOUPO
  761. MSOUPO=MCHPOI.IPCHP(IA)
  762. MSOUP1=MCHPO1.IPCHP(IA)
  763. MPOVAL=MSOUPO.IPOVAL
  764. MPOVA1=MSOUP1.IPOVAL
  765. N =MPOVAL.VPOCHA(/1)
  766. NC=MPOVAL.VPOCHA(/2)
  767. IRES = MOD(N,NBTHR)
  768. IF (IRES .EQ. 0) THEN
  769. ILON = N / NBTHR
  770. IDEB = (ithr -1)* ILON + 1
  771. ELSE
  772. IF (ithr .LE. IRES) THEN
  773. ILON = (N / NBTHR) + 1
  774. IDEB = (ithr -1)* ILON + 1
  775. ELSE
  776. ILON = N / NBTHR
  777. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  778. ENDIF
  779. ENDIF
  780. IFIN = IDEB + ILON - 1
  781. DO 1801 IC=1,NC
  782. DO 1801 IB = IDEB,IFIN
  783. MPOVAL.VPOCHA(IB,IC)=ERF(MPOVA1.VPOCHA(IB,IC))
  784. 1801 CONTINUE
  785. RETURN
  786.  
  787.  
  788. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  789. C ERFC (Fonction Erreur Complementaire 1-ERF(x))
  790. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  791. 19 CONTINUE
  792. DO 1901 IA=1,NSOUPO
  793. MSOUPO=MCHPOI.IPCHP(IA)
  794. MSOUP1=MCHPO1.IPCHP(IA)
  795. MPOVAL=MSOUPO.IPOVAL
  796. MPOVA1=MSOUP1.IPOVAL
  797. N =MPOVAL.VPOCHA(/1)
  798. NC=MPOVAL.VPOCHA(/2)
  799. IRES = MOD(N,NBTHR)
  800. IF (IRES .EQ. 0) THEN
  801. ILON = N / NBTHR
  802. IDEB = (ithr -1)* ILON + 1
  803. ELSE
  804. IF (ithr .LE. IRES) THEN
  805. ILON = (N / NBTHR) + 1
  806. IDEB = (ithr -1)* ILON + 1
  807. ELSE
  808. ILON = N / NBTHR
  809. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  810. ENDIF
  811. ENDIF
  812. IFIN = IDEB + ILON - 1
  813. DO 1901 IC=1,NC
  814. DO 1901 IB = IDEB,IFIN
  815. MPOVAL.VPOCHA(IB,IC)=ERFC(MPOVA1.VPOCHA(IB,IC))
  816. 1901 CONTINUE
  817. RETURN
  818.  
  819.  
  820. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  821. C ARCOSH
  822. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  823. 20 CONTINUE
  824. DO 2001 IA=1,NSOUPO
  825. MSOUPO=MCHPOI.IPCHP(IA)
  826. MSOUP1=MCHPO1.IPCHP(IA)
  827. MPOVAL=MSOUPO.IPOVAL
  828. MPOVA1=MSOUP1.IPOVAL
  829. N =MPOVAL.VPOCHA(/1)
  830. NC=MPOVAL.VPOCHA(/2)
  831. IRES = MOD(N,NBTHR)
  832. IF (IRES .EQ. 0) THEN
  833. ILON = N / NBTHR
  834. IDEB = (ithr -1)* ILON + 1
  835. ELSE
  836. IF (ithr .LE. IRES) THEN
  837. ILON = (N / NBTHR) + 1
  838. IDEB = (ithr -1)* ILON + 1
  839. ELSE
  840. ILON = N / NBTHR
  841. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  842. ENDIF
  843. ENDIF
  844. IFIN = IDEB + ILON - 1
  845. DO 2001 IC=1,NC
  846. DO 2001 IB = IDEB,IFIN
  847. X2 = MPOVA1.VPOCHA(IB,IC)
  848. IF (X2 .GE. 1.) THEN
  849. MPOVAL.VPOCHA(IB,IC)=LOG(X2 + SQRT((X2**2) - 1.))
  850. ELSE
  851. SERROR.BERROR(ithr) = .TRUE.
  852. RETURN
  853. ENDIF
  854. 2001 CONTINUE
  855. RETURN
  856.  
  857.  
  858. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  859. C ARSINH
  860. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  861. 21 CONTINUE
  862. DO 2101 IA=1,NSOUPO
  863. MSOUPO=MCHPOI.IPCHP(IA)
  864. MSOUP1=MCHPO1.IPCHP(IA)
  865. MPOVAL=MSOUPO.IPOVAL
  866. MPOVA1=MSOUP1.IPOVAL
  867. N =MPOVAL.VPOCHA(/1)
  868. NC=MPOVAL.VPOCHA(/2)
  869. IRES = MOD(N,NBTHR)
  870. IF (IRES .EQ. 0) THEN
  871. ILON = N / NBTHR
  872. IDEB = (ithr -1)* ILON + 1
  873. ELSE
  874. IF (ithr .LE. IRES) THEN
  875. ILON = (N / NBTHR) + 1
  876. IDEB = (ithr -1)* ILON + 1
  877. ELSE
  878. ILON = N / NBTHR
  879. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  880. ENDIF
  881. ENDIF
  882. IFIN = IDEB + ILON - 1
  883. DO 2101 IC=1,NC
  884. DO 2101 IB = IDEB,IFIN
  885. X2 = MPOVA1.VPOCHA(IB,IC)
  886. MPOVAL.VPOCHA(IB,IC)=LOG(X2 + SQRT((X2**2) + 1.))
  887. 2101 CONTINUE
  888. RETURN
  889.  
  890.  
  891. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  892. C ARTANH
  893. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  894. 22 CONTINUE
  895. DO 2201 IA=1,NSOUPO
  896. MSOUPO=MCHPOI.IPCHP(IA)
  897. MSOUP1=MCHPO1.IPCHP(IA)
  898. MPOVAL=MSOUPO.IPOVAL
  899. MPOVA1=MSOUP1.IPOVAL
  900. N =MPOVAL.VPOCHA(/1)
  901. NC=MPOVAL.VPOCHA(/2)
  902. IRES = MOD(N,NBTHR)
  903. IF (IRES .EQ. 0) THEN
  904. ILON = N / NBTHR
  905. IDEB = (ithr -1)* ILON + 1
  906. ELSE
  907. IF (ithr .LE. IRES) THEN
  908. ILON = (N / NBTHR) + 1
  909. IDEB = (ithr -1)* ILON + 1
  910. ELSE
  911. ILON = N / NBTHR
  912. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  913. ENDIF
  914. ENDIF
  915. IFIN = IDEB + ILON - 1
  916. DO 2201 IC=1,NC
  917. DO 2201 IB = IDEB,IFIN
  918. X2 = MPOVA1.VPOCHA(IB,IC)
  919. IF ((X2 .GT. -1.) .AND. (X2 .LT. 1.)) THEN
  920. MPOVAL.VPOCHA(IB,IC)=0.5*LOG((1. + X2) / (1. - X2))
  921. ELSE
  922. SERROR.BERROR(ithr) = .TRUE.
  923. RETURN
  924. ENDIF
  925. 2201 CONTINUE
  926. RETURN
  927.  
  928.  
  929. END
  930.  
  931.  
  932.  
  933.  

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