Télécharger opche1.eso

Retour à la liste

Numérotation des lignes :

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

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