Télécharger opche1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPCHE1 SOURCE CB215821 17/06/06 21:15:05 9448
  2. SUBROUTINE OPCHE1(IPO1,IOPERA,IARGU,I1,X1,IPO2,IRET)
  3. C=======================================================================
  4. C
  5. C ENTREES
  6. C IPO1 = POINTEUR SUR LE MCHELM
  7. C IPO2 = POINTEUR SUR LE MCHELM (Second Argument ATAN2)
  8. C I1 = ENTIER
  9. C X1 = FLOTTANT
  10.  
  11. C Operations elementaires entre un MCHELM et un ENTIER ou FLOTTANT
  12. C IOPERA= 1 PUISSANCE
  13. C = 2 PRODUIT
  14. C = 3 ADDITION
  15. C = 4 SOUSTRACTION
  16. C = 5 DIVISION
  17. C
  18. C Fonctions sur un MCHELM
  19. C IOPERA= 6 COSINUS
  20. C = 7 SINUS
  21. C = 8 TANGENTE
  22. C = 9 ARCOSINUS
  23. C = 10 ARCSINUS
  24. C = 11 ARCTANGENTE (ATAN A UN ARGUMENT)
  25. C = 12 EXPONENTIELLE
  26. C = 13 LOGARITHME
  27. C = 14 VALEUR ABSOLUE
  28. C = 15 COSINUS HYPERBOLIQUE
  29. C = 16 SINUS HYPERBOLIQUE
  30. C = 17 TANGENTE HYPERBOLIQUE
  31. C = 18 ERF FONCTION D''ERRREUR DE GAUSS
  32. C = 19 ERFC FONCTION D''ERRREUR complementaire DE GAUSS (1-ERF(X))
  33. C = 20 ARGCH (FONCTION RECIPROQUE DE COSH)
  34. C = 21 ARGSH (FONCTION RECIPROQUE DE SINH)
  35. C = 22 ARGTH (FONCTION RECIPROQUE DE TANH)
  36. C
  37. C IARGU = 0 ==> ARGUMENT I1I ET X1I INUTILISES
  38. C IARGU = 1 ==> ARGUMENT I1I UTILISE
  39. C IARGU = 11 ==> ARGUMENT I1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
  40. C IARGU = 2 ==> ARGUMENT X1I UTILISE
  41. C IARGU = 21 ==> ARGUMENT X1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
  42.  
  43. C SORTIES
  44. C IPO2 = MCHELM SOLUTION
  45. C IRET = 1 SI L OPERATION EST POSSIBLE
  46. C = 0 SI L OPERATION EST IMPOSSIBLE
  47. C
  48. C Creation 05/09/2016
  49. C Createur CB215821
  50. C Historique des Corrections apportees :
  51. C -
  52. C -
  53. C
  54. C=======================================================================
  55.  
  56. IMPLICIT INTEGER(I-N)
  57. IMPLICIT REAL*8 (A-H,O-Z)
  58. C
  59. -INC SMCHAML
  60. -INC SMLREEL
  61. -INC SMLENTI
  62. -INC SMEVOLL
  63. -INC SMLMOTS
  64. -INC CCASSIS
  65. -INC CCOPTIO
  66. -INC TMVALUE
  67.  
  68. C Declaration du COMMON pour le travail en parallele
  69. COMMON/optabc/NBTH1,IERR1,IVALUE,NBPOI1,IOPE,IARG,I1I,X1I
  70.  
  71. C Segment quelconque pour la desactivation des segements
  72. SEGMENT ISEG(0)
  73.  
  74. EXTERNAL OPTABi
  75. LOGICAL BTHRD
  76.  
  77. C Pour afficher les lignes gibianes appelees decommenter le CALL
  78. C CALL TRBAC
  79.  
  80. MCHEL2 = 0
  81. MELVA2 = 0
  82. MLREE2 = 0
  83. MLENT2 = 0
  84. NN1 = 0
  85.  
  86. C======================================================================C
  87. C Activation des SEGMENTS pour placer les MELVAL dans le SVALUE
  88. C======================================================================C
  89. MCHEL1=IPO1
  90.  
  91. C IF ((IOPERA .EQ. 3) .OR. (IOPERA .EQ. 4)) THEN
  92. CC Pour les operations + - on n'accepte que les MCHAML a 1
  93. CC seule composante.
  94. CC Pour les fonctions, on traite toutes les composantes en présence
  95. C CALL EXTR17(IPO1,MLMOTS)
  96. C SEGACT,MLMOTS
  97. C JGM=MLMOTS.MOTS(/2)
  98. C SEGDES,MLMOTS
  99. C IF(JGM .GT. 1)THEN
  100. C CALL ERREUR(320)
  101. C RETURN
  102. C ENDIF
  103. C ENDIF
  104.  
  105. SEGINI,MCHELM=MCHEL1
  106. N1 = MCHELM.ICHAML(/1)
  107.  
  108. IF (N1 .EQ. 0)THEN
  109. C Cas du MCHELM vide : On renvoie l'IDENTITE
  110. IPO2 = MCHELM
  111. SEGDES,MCHELM
  112. IRET = 1
  113. RETURN
  114. ENDIF
  115.  
  116. C Ajout lecture second argument pour ATAN2 au lieu de ATAN
  117. IF (IPO2 .GT. 0) THEN
  118. MCHEL2=IPO2
  119. SEGACT,MCHEL2
  120. N12=MCHEL2.ICHAML(/1)
  121. C Les deux objets doivent etre de meme taille
  122. IF (N1 .NE. N12 ) THEN
  123. SEGDES,MCHEL2
  124. SEGSUP,MCHELM
  125. CALL ERREUR(329)
  126. RETURN
  127. ENDIF
  128.  
  129. DO I=1,N1
  130. IF (MCHELM.IMACHE(I).NE.MCHEL2.IMACHE(I)) THEN
  131. SEGDES,MCHEL2
  132. SEGSUP,MCHELM
  133. CALL ERREUR(329)
  134. ENDIF
  135. ENDDO
  136. ENDIF
  137. IPO2=MCHELM
  138.  
  139. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  140. C par thread
  141. IOPTIM = 12500
  142.  
  143. NBPOIN=0
  144. IPOS1 =0
  145.  
  146. C Decompte simplement du nombre de TABLEAUX a placer dans le SEGMENT SVALUE
  147. DO IA=1,N1
  148. MCHAM1 = MCHELM.ICHAML(IA)
  149. SEGINI,MCHAML = MCHAM1
  150. MCHELM.ICHAML(IA) = MCHAML
  151. N2 = MCHAML.IELVAL(/1)
  152. DO IB=1,N2
  153. MELVA1 = MCHAML.IELVAL(IB)
  154. SEGACT,MELVA1
  155. N2PT0 = MELVA1.IELCHE(/1)
  156. N2EL0 = MELVA1.IELCHE(/2)
  157. IF (N2PT0 .EQ. 0 .AND. N2EL0.EQ. 0) THEN
  158. C Cas des 'REAL*8'
  159. NBPOIN = NBPOIN + 1
  160. ELSEIF(MCHAML.TYPCHE(IB) .EQ. 'POINTEURLISTREEL' .OR.
  161. & MCHAML.TYPCHE(IB) .EQ. 'POINTEURLISTENTI' ) THEN
  162. NBPOIN = NBPOIN + (N2PT0*N2EL0)
  163. ELSEIF(MCHAML.TYPCHE(IB) .EQ. 'POINTEUREVOLUTIO' ) THEN
  164. DO IEL=1,N2EL0
  165. DO IPEL=1,N2PT0
  166. MEVOL1=MELVA1.IELCHE(IPEL,IEL)
  167. SEGACT,MEVOL1
  168. N=MEVOL1.IEVOLL(/1)
  169. SEGDES,MEVOL1
  170. NBPOIN = NBPOIN + N
  171. ENDDO
  172. ENDDO
  173. ELSE
  174. MOTERR(1:16 ) = MCHAML.TYPCHE(IB)
  175. MOTERR(17:20) = MCHAML.NOMCHE(IB)
  176. MOTERR(21:36) = 'argument '
  177. CALL ERREUR(552)
  178. ENDIF
  179. ENDDO
  180. ENDDO
  181.  
  182. SEGINI,SVALUE
  183.  
  184. DO 40 IA=1,N1
  185. MCHAML=MCHELM.ICHAML(IA)
  186. N2 = MCHAML.IELVAL(/1)
  187.  
  188. C Verif du meme nombre de composante si second argument
  189. IF(MCHEL2 .GT. 0) THEN
  190. MCHAM2 = MCHEL2.ICHAML(IA)
  191. SEGACT,MCHAM2
  192. IF(MCHAM2.IELVAL(/1).NE. N2) THEN
  193. CALL ERREUR(488)
  194.  
  195. DO K = 1,IA
  196. MCHAML = MCHELM.ICHAML(K)
  197. SEGSUP,MCHAML
  198. MCHAM2 = MCHEL2.ICHAML(K)
  199. SEGDES,MCHAM2
  200. ENDDO
  201. ENDIF
  202. ENDIF
  203.  
  204. C Travail sur les COMPOSANTES
  205. DO J = 1,N2
  206. MELVA1 = MCHAML.IELVAL(J)
  207. N1PT0 = MELVA1.VELCHE(/1)
  208. N1EL0 = MELVA1.VELCHE(/2)
  209. N2PT0 = MELVA1.IELCHE(/1)
  210. N2EL0 = MELVA1.IELCHE(/2)
  211.  
  212. NN0 = MAX(N1PT0*N1EL0,N2PT0*N2EL0)
  213.  
  214. C On a donne 2 arguments, des verifications supplementaires sont necessaires
  215. IF(MCHEL2 .GT. 0) THEN
  216. C Verification du Type
  217. IF (MCHAM2.TYPCHE(J) .NE. 'REAL*8') THEN
  218. C Le type %m1:16 de la composante %m17:20 du champ par
  219. C element %m21:36 ne correspond pas a celui attendu
  220. MOTERR(1:16 ) = MCHAM2.TYPCHE(J)
  221. MOTERR(17:20) = MCHAM2.NOMCHE(J)
  222. MOTERR(21:36) = 'argument '
  223. CALL ERREUR(552)
  224. DO K = 1,IA
  225. MCHAML = MCHELM.ICHAML(K)
  226. SEGSUP,MCHAML
  227. ENDDO
  228. SEGSUP,MCHELM
  229. RETURN
  230. ENDIF
  231.  
  232. C Verification des composantes
  233. IF(MCHAML.NOMCHE(J) .NE. MCHAM2.NOMCHE(J)) THEN
  234. CALL ERREUR(488)
  235. DO K = 1,IA
  236. MCHAML = MCHELM.ICHAML(K)
  237. SEGSUP,MCHAML
  238. MCHAM2 = MCHEL2.ICHAML(K)
  239. SEGDES,MCHAM2
  240. ENDDO
  241. SEGDES,MCHEL2
  242. SEGSUP,MCHELM
  243. RETURN
  244. ENDIF
  245.  
  246. MELVA2 = MCHAM2.IELVAL(J)
  247. SEGACT,MELVA2
  248. N1PT1 = MELVA2.VELCHE(/1)
  249. N1EL1 = MELVA2.VELCHE(/2)
  250. N2PT1 = MELVA2.IELCHE(/1)
  251. N2EL1 = MELVA2.IELCHE(/2)
  252. NN1 = MAX(N1PT1*N1EL1,N2PT1*N2EL1)
  253. ENDIF
  254.  
  255. NN2 = MAX(NN0 ,NN1 )
  256. N1PTEL = MAX(N1PT0,N1PT1)
  257. N1EL = MAX(N1EL0,N1EL1)
  258. N2PTEL = MAX(N2PT0,N2PT1)
  259. N2EL = MAX(N2EL0,N2EL1)
  260. SEGINI,MELVAL
  261. MCHAML.IELVAL(J) = MELVAL
  262.  
  263. IF (MCHAML.TYPCHE(J) .EQ. 'REAL*8' ) THEN
  264. IPOS1 = IPOS1 + 1
  265. SVALUE.ITYPOI (IPOS1 )= 2
  266. SVALUE.IPOI0 (IPOS1,1)= MELVA1
  267. SVALUE.IPOI1 (IPOS1,1)= MELVA2
  268. SVALUE.IPOI2 (IPOS1,1)= MELVAL
  269. SVALUE.IPOI0 (IPOS1,2)= NN0
  270. SVALUE.IPOI1 (IPOS1,2)= NN1
  271. SVALUE.IPOI2 (IPOS1,2)= NN2
  272. IF (IPOS1 .EQ. 1) THEN
  273. NT1 = NN2 / IOPTIM
  274. ELSE
  275. NT1 = MAX(NT1, NN2/IOPTIM)
  276. ENDIF
  277.  
  278. ELSEIF(MCHAML.TYPCHE(J) .EQ. 'POINTEURLISTREEL') THEN
  279. MLREE2 = 0
  280. DO IEL=1,N2EL0
  281. DO IPEL=1,N2PT0
  282. MLREE1 = MELVA1.IELCHE(IPEL,IEL)
  283. SEGACT,MLREE1
  284. JG = MLREE1.PROG(/1)
  285. SEGINI,MLREEL
  286. MELVAL.IELCHE(IPEL,IEL) = MLREEL
  287.  
  288. IPOS1 = IPOS1 + 1
  289. SVALUE.ITYPOI (IPOS1 )= 3
  290. SVALUE.IPOI0 (IPOS1,1)= MLREE1
  291. SVALUE.IPOI1 (IPOS1,1)= MLREE2
  292. SVALUE.IPOI2 (IPOS1,1)= MLREEL
  293. SVALUE.IPOI0 (IPOS1,2)= JG
  294. SVALUE.IPOI1 (IPOS1,2)= JG
  295. SVALUE.IPOI2 (IPOS1,2)= JG
  296. IF (IPOS1 .EQ. 1) THEN
  297. NT1 = JG / IOPTIM
  298. ELSE
  299. NT1 = MAX(NT1, JG/IOPTIM)
  300. ENDIF
  301. ENDDO
  302. ENDDO
  303. SEGDES,MELVA1
  304.  
  305. ELSEIF(MCHAML.TYPCHE(J) .EQ. 'POINTEURLISTENTI') THEN
  306. MLENT2 = 0
  307. DO IEL=1,N2EL0
  308. DO IPEL=1,N2PT0
  309. MLENT1 = MELVA1.IELCHE(IPEL,IEL)
  310. SEGACT,MLENT1
  311. JG = MLENT1.LECT(/1)
  312. SEGINI,MLENTI
  313. MELVAL.IELCHE(IPEL,IEL) = MLENTI
  314.  
  315. IPOS1 = IPOS1 + 1
  316. SVALUE.ITYPOI (IPOS1 )= 4
  317. SVALUE.IPOI0 (IPOS1,1)= MLENT1
  318. SVALUE.IPOI1 (IPOS1,1)= MLENT2
  319. SVALUE.IPOI2 (IPOS1,1)= MLENTI
  320. SVALUE.IPOI0 (IPOS1,2)= JG
  321. SVALUE.IPOI1 (IPOS1,2)= JG
  322. SVALUE.IPOI2 (IPOS1,2)= JG
  323. IF (IPOS1 .EQ. 1) THEN
  324. NT1 = JG / IOPTIM
  325. ELSE
  326. NT1 = MAX(NT1, JG/IOPTIM)
  327. ENDIF
  328. ENDDO
  329. ENDDO
  330. SEGDES,MELVA1
  331.  
  332. ELSEIF(MCHAML.TYPCHE(J) .EQ. 'POINTEUREVOLUTIO') THEN
  333. MLREE2 = 0
  334. MLENT2 = 0
  335. DO IEL=1,N2EL0
  336. DO IPEL=1,N2PT0
  337. MEVOL1 = MELVA1.IELCHE(IPEL,IEL)
  338. SEGINI,MEVOLL=MEVOL1
  339. MELVAL.IELCHE(IPEL,IEL)=MEVOLL
  340. N=MEVOLL.IEVOLL(/1)
  341. DO IEV1=1,N
  342. KEVOL1 = MEVOLL.IEVOLL(IEV1)
  343. SEGINI,KEVOLL=KEVOL1
  344. MEVOLL.IEVOLL(IEV1)=KEVOLL
  345. IF (KEVOLL.TYPY .EQ. 'LISTREEL') THEN
  346. MLREE1 = KEVOLL.IPROGY
  347. SEGACT,MLREE1
  348. JG = MLREE1.PROG(/1)
  349. SEGINI,MLREEL
  350. KEVOLL.IPROGY = MLREEL
  351.  
  352. IPOS1 = IPOS1 + 1
  353. SVALUE.ITYPOI (IPOS1 )= 3
  354. SVALUE.IPOI0 (IPOS1,1)= MLREE1
  355. SVALUE.IPOI1 (IPOS1,1)= MLREE2
  356. SVALUE.IPOI2 (IPOS1,1)= MLREEL
  357. SVALUE.IPOI0 (IPOS1,2)= JG
  358. SVALUE.IPOI1 (IPOS1,2)= JG
  359. SVALUE.IPOI2 (IPOS1,2)= JG
  360. IF (IPOS1 .EQ. 1) THEN
  361. NT1 = JG / IOPTIM
  362. ELSE
  363. NT1 = MAX(NT1, JG/IOPTIM)
  364. ENDIF
  365.  
  366. ELSEIF (KEVOLL.TYPY .EQ. 'LISTENTI') THEN
  367. MLENT1 = KEVOLL.IPROGY
  368. SEGACT,MLENT1
  369. JG = MLENT1.LECT(/1)
  370. SEGINI,MLENTI
  371. KEVOLL.IPROGY = MLENTI
  372.  
  373. IPOS1 = IPOS1 + 1
  374. SVALUE.ITYPOI (IPOS1 )= 4
  375. SVALUE.IPOI0 (IPOS1,1)= MLENT1
  376. SVALUE.IPOI1 (IPOS1,1)= MLENT2
  377. SVALUE.IPOI2 (IPOS1,1)= MLENTI
  378. SVALUE.IPOI0 (IPOS1,2)= JG
  379. SVALUE.IPOI1 (IPOS1,2)= JG
  380. SVALUE.IPOI2 (IPOS1,2)= JG
  381. IF (IPOS1 .EQ. 1) THEN
  382. NT1 = JG / IOPTIM
  383. ELSE
  384. NT1 = MAX(NT1, JG/IOPTIM)
  385. ENDIF
  386.  
  387. ELSE
  388. MOTERR(1:8 )=KEVOLL.TYPY
  389. IF (IARGU .EQ. 1 .OR. IARGU .EQ. 11) THEN
  390. MOTERR(9:16)='ENTIER '
  391. CALL ERREUR(532)
  392. ELSEIF (IARGU .EQ. 2 .OR. IARGU .EQ. 21) THEN
  393. MOTERR(9:16)='FLOTTANT'
  394. CALL ERREUR(532)
  395. ELSE
  396. MOTERR(9:16)='???? '
  397. CALL ERREUR(532)
  398. ENDIF
  399. RETURN
  400. ENDIF
  401. SEGDES,KEVOLL
  402. ENDDO
  403. SEGDES,MEVOLL
  404. ENDDO
  405. ENDDO
  406. SEGDES,MELVA1
  407. ELSE
  408. C Le type %m1:16 de la composante %m17:20 du champ par
  409. C element %m21:36 ne correspond pas a celui attendu
  410. MOTERR(1:16 ) = MCHAML.TYPCHE(J)
  411. MOTERR(17:20) = MCHAML.NOMCHE(J)
  412. MOTERR(21:36) = 'argument '
  413. CALL ERREUR(552)
  414. DO K = 1,IA
  415. MCHAML = MCHELM.ICHAML(K)
  416. SEGSUP,MCHAML
  417. ENDDO
  418. SEGSUP,MCHELM
  419. RETURN
  420. ENDIF
  421. ENDDO
  422.  
  423. IF (MCHEL2 .GT. 0) THEN
  424. SEGDES,MCHAM2,MCHAML
  425. ELSE
  426. SEGDES,MCHAML
  427. ENDIF
  428. 40 CONTINUE
  429.  
  430. IF (MCHEL2 .GT. 0) THEN
  431. SEGDES,MCHEL2,MCHELM
  432. ELSE
  433. SEGDES,MCHELM
  434. ENDIF
  435.  
  436. C======================================================================C
  437. C Partie pour lancer le travail sur les Threads en parallele
  438. C======================================================================C
  439. ITH = 0
  440. IF (NBESC .NE. 0) CALL OOONTH(ITH)
  441. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  442. C DEJA DANS LES ASSISTANTS
  443. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  444. NBTHR = 1
  445. ITH = 1
  446. BTHRD = .FALSE.
  447. ELSE
  448. BTHRD = .TRUE.
  449. NBTHR = MIN(NT1, NBTHRS)
  450. ENDIF
  451.  
  452. C INITIALISATION DU SEGMENT D''ERREUR
  453. SEGINI,SERROR
  454.  
  455. IF (BTHRD) THEN
  456. CALL THREADII
  457. C Remplissage du 'COMMON/optabc' apres THREADII : pthread_mutex_lock
  458. C sinon soucis de cohabitation entre les ASSISTANTS qui ecrivent tous dans le meme COMMON...
  459. NBTH1 = NBTHR
  460. IERR1 = SERROR
  461. IVALUE = SVALUE
  462. NBPOI1 = NBPOIN
  463. IOPE = IOPERA
  464. IARG = IARGU
  465. I1I = I1
  466. X1I = X1
  467.  
  468. DO ith=2,NBTHR
  469. CALL THREADID(ith,OPTABi)
  470. CALL THREADIF(ith)
  471. IRET=SERROR.IERROR(ith)
  472. IF (IRET .GT. 0) THEN
  473. CALL ERREUR(IRET)
  474. RETURN
  475. ENDIF
  476. ENDDO
  477. CALL OPTABi(1)
  478. IRET=SERROR.IERROR(1)
  479. IF (IRET .GT. 0) THEN
  480. CALL ERREUR(IRET)
  481. RETURN
  482. ENDIF
  483.  
  484. C En multithread il peut y avoir n''importe quoi dans OOV(1)
  485. C Indicateur de l'utilisation d'un élément de segment
  486. OOV(1) = 0
  487.  
  488. ELSE
  489. C Appel de la SUBROUTINE qui fait le travail
  490. DO 99 IA=1,NBPOIN
  491. NTABEN = 1
  492. ITYP = SVALUE.ITYPOI (IA )
  493. ITAIL1=SVALUE.IPOI0 (IA,2)
  494. ITAIL2=SVALUE.IPOI1 (IA,2)
  495. ITAIL3=SVALUE.IPOI2 (IA,2)
  496.  
  497. MELVA1=SVALUE.IPOI0 (IA,1)
  498. MELVA2=SVALUE.IPOI1 (IA,1)
  499. MELVAL=SVALUE.IPOI2 (IA,1)
  500.  
  501. C Traitement direct du bon type d''OBJET de Cast3M
  502. GOTO ( 1, 2, 3, 4),ITYP
  503.  
  504. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  505. C MPOVAL.VPOCHA
  506. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  507. 1 CONTINUE
  508. C Cela n'est pas prevu pour le moment MCHAML de POINTEURCHPOINT
  509. CALL ERREUR(21)
  510. RETURN
  511.  
  512. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  513. C MELVAL.VELCHE
  514. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  515. 2 CONTINUE
  516. MELVA1=SVALUE.IPOI0 (IA,1)
  517. MELVA2=SVALUE.IPOI1 (IA,1)
  518. MELVAL=SVALUE.IPOI2 (IA,1)
  519.  
  520. IF (MELVA2 .GT. 0) THEN
  521. NTABEN = 2
  522. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  523. & MELVA1.VELCHE,MELVA2.VELCHE,MELVAL.VELCHE,
  524. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  525. ELSE
  526. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  527. & MELVA1.VELCHE,MELVA1.VELCHE,MELVAL.VELCHE,
  528. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  529. ENDIF
  530. GOTO 99
  531.  
  532. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  533. C MLREEL.PROG
  534. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  535. 3 CONTINUE
  536. MLREE1=SVALUE.IPOI0 (IA,1)
  537. MLREE2=SVALUE.IPOI1 (IA,1)
  538. MLREEL=SVALUE.IPOI2 (IA,1)
  539. IF (MLREE2 .GT. 0) THEN
  540. NTABEN = 2
  541. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  542. & MLREE1.PROG,MLREE2.PROG,MLREEL.PROG,
  543. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  544. ELSE
  545. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  546. & MLREE1.PROG,MLREE1.PROG,MLREEL.PROG,
  547. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  548. ENDIF
  549. GOTO 99
  550.  
  551. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  552. C MLENTI.LECT
  553. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  554. 4 CONTINUE
  555. MLENT1=SVALUE.IPOI0 (IA,1)
  556. MLENT2=SVALUE.IPOI1 (IA,1)
  557. MLENTI=SVALUE.IPOI2 (IA,1)
  558.  
  559. C CB215821 : Operation non prevue encore sur les LISTENTI !!!
  560. CALL ERREUR(21)
  561. RETURN
  562.  
  563. C IF (MLENT2 .GT. 0) THEN
  564. C NTABEN = 2
  565. C CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  566. C & MLENT1.LECT,MLENT2.LECT,MLENTI.LECT,
  567. C & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  568. C ELSE
  569. C CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  570. C & MLENT1.LECT,MLENT1.LECT,MLENTI.LECT,
  571. C & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  572. C ENDIF
  573. C GOTO 99
  574.  
  575. 99 CONTINUE
  576. IRET=SERROR.IERROR(1)
  577. IF (IRET .GT. 0) THEN
  578. CALL ERREUR(IRET)
  579. RETURN
  580. ENDIF
  581. ENDIF
  582.  
  583. IF (BTHRD) CALL THREADIS
  584.  
  585. C======================================================================C
  586. C Boucle pour desactiver les SEGMENTS
  587. C======================================================================C
  588. DO 50 IA=1,NBPOIN
  589. ISEG = SVALUE.IPOI0(IA,1)
  590. IF (ISEG.NE.0) SEGDES,ISEG
  591. ISEG = SVALUE.IPOI1(IA,1)
  592. IF (ISEG.NE.0) SEGDES,ISEG
  593. ISEG = SVALUE.IPOI2(IA,1)
  594. IF (ISEG.NE.0) SEGDES,ISEG
  595. 50 CONTINUE
  596. SEGSUP,SERROR,SVALUE
  597.  
  598. IRET = 1
  599. RETURN
  600. END
  601.  
  602.  
  603.  
  604.  

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