Télécharger opche1.eso

Retour à la liste

Numérotation des lignes :

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

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