Télécharger devso4.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVSO4 SOURCE BP208322 17/07/18 21:15:04 9498
  2. SUBROUTINE DEVSO4(KPREF,KTRES,KTLIAA,KTLIAB,KTNUM,NINS,
  3. & ICHAIN,MTABLE,REPRIS,LMODYN,ITDYN,ITSORT)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Creation et remplissage de la table resultat *
  12. * *
  13. * Parametres: *
  14. * *
  15. * e KTRES segment de sauvegarde des resultats *
  16. * e KTLIAA segment descriptif des liaisons en base A *
  17. * e KTLIAB segment descriptif des liaisons en base B *
  18. * e KTNUM segment contenant les parametres numeriques *
  19. * e NINS on veut une sortie tous les NINS pas de calcul *
  20. * e ICHAIN Segment MLENTI (ACTIF) contenant les adresses des *
  21. * chaines dans la pile des mots de CCNOYAU *
  22. * s MTABLE table resultat de l'operateur DYNE *
  23. * e REPRIS vrai si reprise de calcul, faux sinon *
  24. * *
  25. * Auteur, date de creation : *
  26. * *
  27. * Denis ROBERT-MOUGIN, le 11 aout 1989. *
  28. * IBRAHIM PINTO, 05/97 , LIAISONS SEGEMENT_CERCLE *
  29. *--------------------------------------------------------------------*
  30. -INC CCOPTIO
  31. -INC SMTABLE
  32. -INC SMLREEL
  33. -INC SMLENTI
  34. -INC SMCHPOI
  35. *
  36. SEGMENT,MPREF
  37. INTEGER IPOREF(NPREF)
  38. ENDSEGMENT
  39. SEGMENT,MTLIAA
  40. INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  41. REAL*8 XPALA(NLIAA,NXPALA)
  42. ENDSEGMENT
  43. SEGMENT,MTLIAB
  44. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  45. REAL*8 XPALB(NLIAB,NXPALB)
  46. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  47. ENDSEGMENT
  48. SEGMENT,MTRES
  49. REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
  50. REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
  51. REAL*8 XMREP(NLIAB,4,IDIMB)
  52. INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP)
  53. INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
  54. INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
  55. INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
  56. INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
  57. INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
  58. INTEGER ILPOLA(NLIAA,2)
  59. ENDSEGMENT
  60. SEGMENT,MTNUM
  61. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  62. ENDSEGMENT
  63. *
  64. POINTEUR LCHAIN.MLENTI
  65. POINTEUR MTABU.MTABLE, MTAB4.MTABLE
  66. *
  67. INTEGER ipotab(8)
  68. LOGICAL L0,L1,REPRIS,LMODYN
  69. CHARACTER*8 TYPRET,TYPOBJ
  70. CHARACTER*72 CHARRE,CHARRI
  71. *
  72. MPREF = KPREF
  73. MTRES = KTRES
  74. MTLIAA = KTLIAA
  75. MTLIAB = KTLIAB
  76. MTNUM = KTNUM
  77. NRES = XRES(/1)
  78. NCRES = XRES(/2)
  79. NPRES = XRES(/3)
  80. NREP = XREP(/1)
  81. NLSA = XRESLA(/1)
  82. NLSB = XRESLB(/1)
  83. NTVAR = ILIREB(/2)
  84. NLIAB = XMREP(/1)
  85. NLIAA = ILPOLA(/1)
  86. IF (MTLIAA.NE.0) THEN
  87. NPLAA = IPLIA(/2)
  88. NXPALA = XPALA(/2)
  89. ELSE
  90. NPLAA = 0
  91. NXPALA = 0
  92. ENDIF
  93. NPLB = JPLIB(/1)
  94. IDIMB = XMREP(/3)
  95. LCHAIN = ICHAIN
  96. INDC10 = -12345
  97. MTAB1 = -6661
  98. MTAB3 = -6663
  99.  
  100. IF (ITSORT.EQ.INDC10) GOTO 1234
  101.  
  102. *
  103. *---------- CREATION DE LA TABLE RESULTAT : ----------
  104. *
  105. M = 3 + NLSA + NLSB
  106. IF (NRES.NE.0) THEN
  107. M = M + NPRES
  108. ENDIF
  109. SEGINI,MTABLE
  110. MLOTAB = M
  111.  
  112. *
  113. * Sous-typage de la table resultat:
  114. *
  115. MTABTI(1) = 'MOT'
  116. ICHA6 = LCHAIN.LECT(6)
  117. MTABII(1) = ICHA6
  118. MTABTV(1) = 'MOT'
  119. ICHA1 = LCHAIN.LECT(1)
  120. MTABIV(1) = ICHA1
  121.  
  122. *
  123. *---------- CREATION DE LA LISTE DES TEMPS ----------
  124. *
  125. IINS = 1
  126. IF ( REPRIS ) IINS = NINS + 1
  127. MLREEL = IPOLR(1)
  128. segact mlreel*mod
  129. DO 10 IRES = 1,NPRES
  130. PROG(IRES) = XTEMPS(IINS)
  131. IINS = IINS + NINS
  132. 10 CONTINUE
  133. * end do
  134. SEGDES,MLREEL
  135. *
  136. * Ecriture de la liste des temps de sortie dans la table resultat
  137. *
  138. MTABTI(2) = 'MOT'
  139. ICHA3 = LCHAIN.LECT(3)
  140. MTABII(2) = ICHA3
  141. MTABTV(2) = 'LISTREEL'
  142. MTABIV(2) = MLREEL
  143.  
  144.  
  145. *---------- CREATION DU BLOC DE REPRISE : ----------
  146.  
  147. *+* SOUSTYPE / TEMPS_DE_REPRISE / variables "principales"
  148. M = NREP + 2
  149. IF (NLIAA.NE.0) THEN
  150. IPOLY = 0
  151. DO 180 I = 1,NLIAA
  152. IF (ILPOLA(I,1).NE.0) IPOLY = IPOLY + 1
  153. 180 CONTINUE
  154. IF (IPOLY.NE.0) M = M + 1
  155. ENDIF
  156. IF (NLIAB.NE.0) M = M + 1
  157. SEGINI,MTAB2
  158. MTAB2.MLOTAB = M
  159. *
  160. * --- Sous-typage du bloc de reprise:
  161. *
  162. MTAB2.MTABTI(1) = 'MOT'
  163. ICHA6 = LCHAIN.LECT(6)
  164. MTAB2.MTABII(1) = ICHA6
  165. MTAB2.MTABTV(1) = 'MOT'
  166. ICHA5 = LCHAIN.LECT(5)
  167. MTAB2.MTABIV(1) = ICHA5
  168. *
  169. * --- Ecriture du temps de reprise:
  170. *
  171. TREPRI = XTEMPS(IINS-NINS)
  172. MTAB2.MTABTI(2) = 'MOT'
  173. ICHA4 = LCHAIN.LECT(4)
  174. MTAB2.MTABII(2) = ICHA4
  175. MTAB2.MTABTV(2) = 'FLOTTANT'
  176. MTAB2.RMTABV(2) = TREPRI
  177. *
  178. * --- Ecriture des CHPOINTs de reprise:
  179. *
  180. J2 = 2
  181. DO 20 J = 1,NREP
  182. J2 = J2 + 1
  183. MTAB2.MTABTI(J2) = 'MOT'
  184. ICHAR = LCHAIN.LECT(6+J)
  185. * chpoints des travaux
  186. IF (J.GT.8) ICHAR = LCHAIN.LECT(74+J)
  187.  
  188. MTAB2.MTABII(J2) = ICHAR
  189. MTAB2.MTABTV(J2) = 'CHPOINT'
  190. MTAB2.MTABIV(J2) = IPOREP(J)
  191. 20 CONTINUE
  192. *
  193. * --- Ecriture des variables de liaison en base A
  194. *
  195. IF (NLIAA.NE.0) THEN
  196. *
  197. IF (IIMPI.EQ.333) THEN
  198. WRITE(IOIMP,*)'DEVSO4 : bloc reprise liaison base A '
  199. WRITE(IOIMP,*)'Nombre de liaisons a sauver : ',IPOLY
  200. ENDIF
  201. IF (IPOLY.NE.0) THEN
  202. M = IPOLY
  203. SEGINI,MTAB1
  204. MTAB1.MLOTAB = M
  205. * Boucle sur les liaisons en base A (I)
  206. II = 0
  207. DO 200 I = 1,NLIAA
  208. IF (IIMPI.EQ.333)
  209. & WRITE(IOIMP,*)'I = ',I,' ILPOLA = ',ILPOLA(I,1)
  210. * indice du numero de liaison base A
  211. * II = II + 1
  212.  
  213. * -- liaisons COUPLAGE_DEPLACEMENT + CONVOLUTION --
  214. IF (ILPOLA(I,1).EQ.2) THEN
  215.  
  216. * creation sous table a l'indice II
  217. II = II + 1
  218. M = 3
  219. SEGINI MTAB3
  220. MTAB3.MLOTAB = M
  221. MTAB1.MTABTI(II) = 'ENTIER'
  222. MTAB1.MTABII(II) = II
  223. MTAB1.MTABTV(II) = 'TABLE'
  224. MTAB1.MTABIV(II) = MTAB3
  225.  
  226. c MTAB3 . 'TYPE' = 5
  227. MTAB3.MTABTI(1) = 'MOT'
  228. ICHAR = LCHAIN.LECT(40)
  229. MTAB3.MTABII(1) = ICHAR
  230. MTAB3.MTABTV(1) = 'ENTIER'
  231. MTAB3.MTABIV(1) = 5
  232.  
  233. c MTAB3 . 'DEPLACEMENT' = listreel
  234. MTAB3.MTABTI(2) = 'MOT'
  235. ICHAR = LCHAIN.LECT(7)
  236. MTAB3.MTABII(2) = ICHAR
  237. MTAB3.MTABTV(2) = 'LISTREEL'
  238. MTAB3.MTABIV(2) = IPALA(I,5)
  239. *
  240. c MTAB3 . 'DEPLACEMENT_1/2' = listreel
  241. MTAB3.MTABTI(3) = 'MOT'
  242. ICHAR = LCHAIN.LECT(9)
  243. MTAB3.MTABII(3) = ICHAR
  244. MTAB3.MTABTV(3) = 'LISTREEL'
  245. MTAB3.MTABIV(3) = IPALA(I,6)
  246. SEGDES MTAB3
  247.  
  248. * -- liaisons POLYNOMIALEs --
  249. ELSEIF (ILPOLA(I,1).NE.0) THEN
  250.  
  251. * creation sous table a l'indice II
  252. II = II + 1
  253. M = 3
  254. SEGINI MTAB3
  255. MTAB3.MLOTAB = M
  256. *
  257. MTAB1.MTABTI(II) = 'ENTIER'
  258. MTAB1.MTABII(II) = II
  259. MTAB1.MTABTV(II) = 'TABLE'
  260. MTAB1.MTABIV(II) = MTAB3
  261. *
  262. c MTAB3 . 'TYPE' = 6
  263. MTAB3.MTABTI(1) = 'MOT'
  264. ICHAR = LCHAIN.LECT(40)
  265. MTAB3.MTABII(1) = ICHAR
  266. MTAB3.MTABTV(1) = 'ENTIER'
  267. MTAB3.MTABIV(1) = 6
  268. *
  269. MLENTI = ILPOLA(I,1)
  270. IPLEN1 = MLENTI
  271. DO 220 J = 1,NPLAA
  272. K = (J*2) - 1
  273. IPP = IPLIA(I,J)
  274. LECT(K) = JPLIA(IPP)
  275. K = J * 2
  276. LECT(K) = IPP
  277. 220 CONTINUE
  278. IF (IIMPI.EQ.333) THEN
  279. NPLA2 = NPLAA * 2
  280. WRITE(IOIMP,*)'DEVSO4 : LECT=',(LECT(j),j=1,NPLA2)
  281. ENDIF
  282. SEGDES MLENTI
  283. *
  284. c MTAB3 . 'POINTS_LIAISON_POLYNOMIALE' = listenti
  285. MTAB3.MTABTI(2) = 'MOT'
  286. ICHAR = LCHAIN.LECT(78)
  287. MTAB3.MTABII(2) = ICHAR
  288. MTAB3.MTABTV(2) = 'LISTENTI'
  289. MTAB3.MTABIV(2) = IPLEN1
  290. *
  291. MLREEL = ILPOLA(I,2)
  292. IPLRE1 = MLREEL
  293. DO 230 J = 1,NXPALA
  294. PROG(J) = XPALA(I,J)
  295. 230 CONTINUE
  296. IF (IIMPI.EQ.333) THEN
  297. WRITE(IOIMP,*)'DEVSO4 : PROG=',(PROG(j),j=1,NXPALA)
  298. ENDIF
  299. SEGDES MLREEL
  300. *
  301. c MTAB3 . 'VARIABLES_LIAISON_POLYNOMIALE' = listreel
  302. MTAB3.MTABTI(3) = 'MOT'
  303. ICHAR = LCHAIN.LECT(79)
  304. MTAB3.MTABII(3) = ICHAR
  305. MTAB3.MTABTV(3) = 'LISTREEL'
  306. MTAB3.MTABIV(3) = IPLRE1
  307. SEGDES MTAB3
  308. ENDIF
  309. 200 CONTINUE
  310. SEGDES MTAB1
  311. *
  312. * Bloc des variables internes liaison A ---> bloc de reprise
  313. *
  314. J2 = J2 + 1
  315. MTAB2.MTABTI(J2) = 'MOT'
  316. ICHAR = LCHAIN.LECT(80)
  317. MTAB2.MTABII(J2) = ICHAR
  318. MTAB2.MTABTV(J2) = 'TABLE'
  319. MTAB2.MTABIV(J2) = MTAB1
  320. ENDIF
  321. ENDIF
  322. * --- fin d'ecriture des variables de liaison en base A
  323. *
  324. * --- Ecriture des variables de liaison en base B
  325. *
  326. IF (NLIAB.NE.0) THEN
  327. M = NLIAB
  328. SEGINI,MTAB1
  329. MTAB1.MLOTAB = M
  330. *
  331. DO 100 I = 1,NLIAB
  332. ITYP = IMREP(I,1)
  333. IF (ITYP.EQ.23 .OR.
  334. & ITYP.EQ.24 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103 .OR.
  335. & ITYP.EQ.13 .OR. ITYP.EQ.113 .OR. ITYP.EQ.5 .OR.
  336. & ITYP.EQ.6 .OR. ITYP.EQ.33 .OR. ITYP.EQ.34
  337. & .OR.ITYP.EQ.-13) THEN
  338. M = 5
  339. SEGINI,MTAB3
  340. MTAB3.MLOTAB = M
  341. *
  342. MTAB1.MTABTI(I) = 'ENTIER'
  343. MTAB1.MTABII(I) = I
  344. MTAB1.MTABTV(I) = 'TABLE'
  345. MTAB1.MTABIV(I) = MTAB3
  346. *
  347. MTAB3.MTABTI(1) = 'MOT'
  348. ICHAR = LCHAIN.LECT(40)
  349. MTAB3.MTABII(1) = ICHAR
  350. MTAB3.MTABTV(1) = 'ENTIER'
  351. MTAB3.MTABIV(1) = ITYP
  352. *
  353. MTAB3.MTABTI(2) = 'MOT'
  354. ICHAR = LCHAIN.LECT(43)
  355. MTAB3.MTABII(2) = ICHAR
  356. MTAB3.MTABTV(2) = 'ENTIER'
  357. MTAB3.MTABIV(2) = IMREP(I,2)
  358. *
  359. MTAB3.MTABTI(3) = 'MOT'
  360. ICHAR = LCHAIN.LECT(41)
  361. MTAB3.MTABII(3) = ICHAR
  362. MTAB3.MTABTV(3) = 'POINT'
  363. MTAB3.MTABIV(3) = IPPREP(I,1)
  364. *
  365. MTAB3.MTABTI(4) = 'MOT'
  366. ICHAR = LCHAIN.LECT(42)
  367. MTAB3.MTABII(4) = ICHAR
  368. MTAB3.MTABTV(4) = 'POINT'
  369. MTAB3.MTABIV(4) = IPPREP(I,2)
  370. *
  371. MTAB3.MTABTI(5) = 'MOT'
  372. ICHAR = LCHAIN.LECT(37)
  373. MTAB3.MTABII(5) = ICHAR
  374. MTAB3.MTABTV(5) = 'POINT'
  375. MTAB3.MTABIV(5) = IPPREP(I,3)
  376.  
  377. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  378.  
  379. M = 6
  380. SEGINI,MTAB3
  381. MTAB3.MLOTAB = M
  382. *
  383. MTAB1.MTABTI(I) = 'ENTIER'
  384. MTAB1.MTABII(I) = I
  385. MTAB1.MTABTV(I) = 'TABLE'
  386. MTAB1.MTABIV(I) = MTAB3
  387. *
  388. MTAB3.MTABTI(1) = 'MOT'
  389. ICHAR = LCHAIN.LECT(40)
  390. MTAB3.MTABII(1) = ICHAR
  391. MTAB3.MTABTV(1) = 'ENTIER'
  392. MTAB3.MTABIV(1) = ITYP
  393. *
  394. MTAB3.MTABTI(2) = 'MOT'
  395. ICHAR = LCHAIN.LECT(43)
  396. MTAB3.MTABII(2) = ICHAR
  397. MTAB3.MTABTV(2) = 'ENTIER'
  398. MTAB3.MTABIV(2) = IMREP(I,2)
  399. *
  400. MTAB3.MTABTI(3) = 'MOT'
  401. ICHAR = LCHAIN.LECT(41)
  402. MTAB3.MTABII(3) = ICHAR
  403. MTAB3.MTABTV(3) = 'POINT'
  404. MTAB3.MTABIV(3) = IPPREP(I,1)
  405. *
  406. MTAB3.MTABTI(4) = 'MOT'
  407. ICHAR = LCHAIN.LECT(42)
  408. MTAB3.MTABII(4) = ICHAR
  409. MTAB3.MTABTV(4) = 'POINT'
  410. MTAB3.MTABIV(4) = IPPREP(I,2)
  411. *
  412. MTAB3.MTABTI(5) = 'MOT'
  413. ICHAR = LCHAIN.LECT(37)
  414. MTAB3.MTABII(5) = ICHAR
  415. MTAB3.MTABTV(5) = 'POINT'
  416. MTAB3.MTABIV(5) = IPPREP(I,3)
  417.  
  418. MTAB3.MTABTI(6) = 'MOT'
  419. ICHAR = LCHAIN.LECT(120)
  420. MTAB3.MTABII(6) = ICHAR
  421. MTAB3.MTABTV(6) = 'POINT'
  422. MTAB3.MTABIV(6) = IPPREP(I,4)
  423.  
  424. ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36 .OR. ITYP.EQ.37
  425. &.OR. ITYP.EQ.38 .OR. ITYP.EQ.39 .OR. ITYP.EQ.40 ) THEN
  426. M = 3
  427. SEGINI,MTAB3
  428. MTAB3.MLOTAB = M
  429. *
  430. MTAB1.MTABTI(I) = 'ENTIER'
  431. MTAB1.MTABII(I) = I
  432. MTAB1.MTABTV(I) = 'TABLE'
  433. MTAB1.MTABIV(I) = MTAB3
  434. *
  435. MTAB3.MTABTI(1) = 'MOT'
  436. ICHAR = LCHAIN.LECT(40)
  437. MTAB3.MTABII(1) = ICHAR
  438. MTAB3.MTABTV(1) = 'ENTIER'
  439. MTAB3.MTABIV(1) = ITYP
  440. *
  441. MTAB3.MTABTI(2) = 'MOT'
  442. ICHAR = LCHAIN.LECT(43)
  443. MTAB3.MTABII(2) = ICHAR
  444. MTAB3.MTABTV(2) = 'ENTIER'
  445. MTAB3.MTABIV(2) = IMREP(I,2)
  446. *
  447. *
  448. * noeud voisin
  449. * creation du list entier contenant les noeuds voisins
  450. NNOEMA = IPALB(I,21)
  451. NNOEES = IPALB(I,22)
  452. JG = (NNOEMA+NNOEES)
  453. SEGINI,MLENTI
  454. DO 120 IVOIS=1,(NNOEMA+NNOEES)
  455. LECT(IVOIS)=IPALB(I,26+IVOIS)
  456. 120 CONTINUE
  457. IVOIS1=MLENTI
  458. SEGDES,MLENTI
  459. MTAB3.MTABTI(3) = 'MOT'
  460. ICHAR = LCHAIN.LECT(103)
  461. MTAB3.MTABII(3) = ICHAR
  462. MTAB3.MTABTV(3) = 'LISTENTI'
  463. MTAB3.MTABIV(3) = IVOIS1
  464. *
  465. ELSE IF (ITYP.EQ.7) THEN
  466. M = 4
  467. SEGINI,MTAB3
  468. MTAB3.MLOTAB = M
  469. *
  470. MTAB1.MTABTI(I) = 'ENTIER'
  471. MTAB1.MTABII(I) = I
  472. MTAB1.MTABTV(I) = 'TABLE'
  473. MTAB1.MTABIV(I) = MTAB3
  474. *
  475. MTAB3.MTABTI(1) = 'MOT'
  476. ICHAR = LCHAIN.LECT(40)
  477. MTAB3.MTABII(1) = ICHAR
  478. MTAB3.MTABTV(1) = 'ENTIER'
  479. MTAB3.MTABIV(1) = ITYP
  480. *
  481. MTAB3.MTABTI(2) = 'MOT'
  482. ICHAR = LCHAIN.LECT(9)
  483. MTAB3.MTABII(2) = ICHAR
  484. MTAB3.MTABTV(2) = 'POINT'
  485. MTAB3.MTABIV(2) = IPPREP(I,1)
  486. *
  487. MTAB3.MTABTI(3) = 'MOT'
  488. ICHAR = LCHAIN.LECT(10)
  489. MTAB3.MTABII(3) = ICHAR
  490. MTAB3.MTABTV(3) = 'POINT'
  491. MTAB3.MTABIV(3) = IPPREP(I,2)
  492. *
  493. MTAB3.MTABTI(4) = 'MOT'
  494. ICHAR = LCHAIN.LECT(12)
  495. MTAB3.MTABII(4) = ICHAR
  496. MTAB3.MTABTV(4) = 'POINT'
  497. MTAB3.MTABIV(4) = IPPREP(I,3)
  498. ** ianis
  499. ELSE IF (ITYP.EQ.100 .OR. ITYP.EQ.101) THEN
  500. M = 2
  501. SEGINI,MTAB3
  502. MTAB3.MLOTAB = M
  503. *
  504. MTAB1.MTABTI(I) = 'ENTIER'
  505. MTAB1.MTABII(I) = I
  506. MTAB1.MTABTV(I) = 'TABLE'
  507. MTAB1.MTABIV(I) = MTAB3
  508. *
  509. MTAB3.MTABTI(1) = 'MOT'
  510. ICHAR = LCHAIN.LECT(40)
  511. MTAB3.MTABII(1) = ICHAR
  512. MTAB3.MTABTV(1) = 'ENTIER'
  513. MTAB3.MTABIV(1) = ITYP
  514. *
  515. IDIM = IPALB(I,3)
  516. id1 = 4
  517. MTAB3.MTABTI(2) = 'MOT'
  518. ICHAR = LCHAIN.LECT(82)
  519. MTAB3.MTABII(2) = ICHAR
  520. MTAB3.MTABTV(2) = 'FLOTTANT'
  521. MTAB3.RMTABV(2) = XPALB(I,id1+idim+1)
  522. *
  523. C NW
  524. ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17) THEN
  525. M = 4
  526. SEGINI,MTAB3
  527. MTAB3.MLOTAB = M
  528. *
  529. MTAB1.MTABTI(I) = 'ENTIER'
  530. MTAB1.MTABII(I) = I
  531. MTAB1.MTABTV(I) = 'TABLE'
  532. MTAB1.MTABIV(I) = MTAB3
  533. *
  534. MTAB3.MTABTI(1) = 'MOT'
  535. ICHAR = LCHAIN.LECT(40)
  536. MTAB3.MTABII(1) = ICHAR
  537. MTAB3.MTABTV(1) = 'ENTIER'
  538. MTAB3.MTABIV(1) = ITYP
  539.  
  540. *
  541. idim = IPALB(I,3)
  542. if (ityp.eq.16) nn = 4 + idim
  543. if (ityp.eq.17) nn = 5 + idim
  544. MTAB3.MTABTI(2) = 'MOT'
  545. ICHAR = LCHAIN.LECT(82)
  546. MTAB3.MTABII(2) = ICHAR
  547. MTAB3.MTABTV(2) = 'FLOTTANT'
  548. MTAB3.RMTABV(2) = XPALB(I,NN-2)
  549.  
  550. MTAB3.MTABTI(3) = 'MOT'
  551. ICHAR = LCHAIN.LECT(100)
  552. MTAB3.MTABII(3) = ICHAR
  553. MTAB3.MTABTV(3) = 'FLOTTANT'
  554. MTAB3.RMTABV(3) = XPALB(I,NN-1)
  555.  
  556. MTAB3.MTABTI(4) = 'MOT'
  557. ICHAR = LCHAIN.LECT(111)
  558. MTAB3.MTABII(4) = ICHAR
  559. MTAB3.MTABTV(4) = 'FLOTTANT'
  560. MTAB3.RMTABV(4) = XPALB(I,NN)
  561.  
  562. *
  563. ELSE IF (ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  564. M = 4
  565. SEGINI,MTAB3
  566. MTAB3.MLOTAB = M
  567. *
  568. MTAB1.MTABTI(I) = 'ENTIER'
  569. MTAB1.MTABII(I) = I
  570. MTAB1.MTABTV(I) = 'TABLE'
  571. MTAB1.MTABIV(I) = MTAB3
  572. *
  573. MTAB3.MTABTI(1) = 'MOT'
  574. ICHAR = LCHAIN.LECT(40)
  575. MTAB3.MTABII(1) = ICHAR
  576. MTAB3.MTABTV(1) = 'ENTIER'
  577. MTAB3.MTABIV(1) = ITYP
  578. *
  579. idim = IPALB(I,3)
  580. if (ityp.eq.50) nn = 4 + idim
  581. if (ityp.eq.51) nn = 5 + idim
  582. MTAB3.MTABTI(2) = 'MOT'
  583. ICHAR = LCHAIN.LECT(102)
  584. MTAB3.MTABII(2) = ICHAR
  585. MTAB3.MTABTV(2) = 'FLOTTANT'
  586. MTAB3.RMTABV(2) = XPALB(I,NN-2)
  587.  
  588. MTAB3.MTABTI(3) = 'MOT'
  589. ICHAR = LCHAIN.LECT(99)
  590. MTAB3.MTABII(3) = ICHAR
  591. MTAB3.MTABTV(3) = 'FLOTTANT'
  592. MTAB3.RMTABV(3) = XPALB(I,NN-1)
  593.  
  594. MTAB3.MTABTI(4) = 'MOT'
  595. ICHAR = LCHAIN.LECT(112)
  596. MTAB3.MTABII(4) = ICHAR
  597. MTAB3.MTABTV(4) = 'FLOTTANT'
  598. MTAB3.RMTABV(4) = XPALB(I,NN)
  599. *
  600. ELSE
  601. M = 1
  602. SEGINI,MTAB3
  603. MTAB3.MLOTAB = M
  604. *
  605. MTAB1.MTABTI(I) = 'ENTIER'
  606. MTAB1.MTABII(I) = I
  607. MTAB1.MTABTV(I) = 'TABLE'
  608. MTAB1.MTABIV(I) = MTAB3
  609. *
  610. MTAB3.MTABTI(1) = 'MOT'
  611. ICHAR = LCHAIN.LECT(40)
  612. MTAB3.MTABII(1) = ICHAR
  613. MTAB3.MTABTV(1) = 'ENTIER'
  614. MTAB3.MTABIV(1) = ITYP
  615. ENDIF
  616. *
  617. SEGDES,MTAB3
  618. 100 CONTINUE
  619. SEGDES,MTAB1
  620. *
  621. * Ecriture du bloc des variables de liaison dans le bloc reprise
  622. *
  623. J2 = J2 + 1
  624. MTAB2.MTABTI(J2) = 'MOT'
  625. ICHAR = LCHAIN.LECT(44)
  626. MTAB2.MTABII(J2) = ICHAR
  627. MTAB2.MTABTV(J2) = 'TABLE'
  628. MTAB2.MTABIV(J2) = MTAB1
  629. ENDIF
  630. * --- fin d'ecriture des variables de liaison en base B
  631. *
  632. SEGDES,MTAB2
  633. *
  634. * --- Ecriture du bloc de reprise dans la table resultat:
  635. *
  636. IF (LMODYN) THEN
  637. iptlar = mtab2
  638. CALL ECCTAB(ITDYN,'MOT',0,0.D0,'REPRISE_DYNE',.TRUE.,0,
  639. # 'TABLE',0,0.D0,CHARRE,.TRUE.,iptlar)
  640. ELSE
  641. MTABTI(3) = 'MOT'
  642. ICHA5 = LCHAIN.LECT(5)
  643. MTABII(3) = ICHA5
  644. MTABTV(3) = 'TABLE'
  645. MTABIV(3) = MTAB2
  646. ENDIF
  647. *
  648. IRE2 = 3
  649.  
  650. *
  651. *---------- CREATION DES TABLES AUX PAS DE SORTIE ----------
  652. *
  653. * --- syntaxe table PASAPAS ---
  654. IF (LMODYN) THEN
  655. *
  656. typobj = ' '
  657. CALL ACCTAB(ITDYN,'MOT',IM,X0,'TEMPS',L0,IP0,
  658. & typobj,np,X1,CHARRE,L1,IPTEMP)
  659. M = 1
  660. segini MTABU
  661. MTABU.MLOTAB = 1
  662. if (iptemp.gt.0.and.typobj(1:8).eq.'TABLE') then
  663. call dimen7(iptemp,idimen)
  664. indi1 = idimen - 1
  665. DO ISOR = 1 , 8
  666. IF (ICHRES(ISOR).EQ.1) THEN
  667. ICHAR = LCHAIN.LECT(6+ISOR)
  668. IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR)
  669. segact MTABU*mod
  670. MTABU.MTABTI(1) = 'ENTIER'
  671. MTABU.MTABII(1) = 1
  672. MTABU.MTABTV(1) = 'MOT'
  673. MTABU.MTABIV(1) = ICHAR
  674. typret=' '
  675. CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  676. & typret,IUI,X1,CHARRE,L1,IP1)
  677. if (CHARRE.EQ.'VITESSE') CHARRE = 'VITESSES'
  678. if (CHARRE.EQ.'DEPLACEMENT') CHARRE = 'DEPLACEMENTS'
  679. CALL ACCTAB(ITDYN,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  680. # 'TABLE',0,0.D0,CHARRI,.TRUE.,IPTCHP)
  681. ipotab(isor) = IPTCHP
  682. ENDIF
  683. ENDDO
  684.  
  685. else
  686.  
  687. CALL CRTABL(IPTEMP)
  688. CALL ECCTAB(ITDYN,'MOT',0,0.D0,'TEMPS',.TRUE.,0,
  689. # 'TABLE',0,0.D0,CHARRE,.TRUE.,iptemp)
  690. indi1 = -1
  691. DO ISOR = 1 , 8
  692. IF (ICHRES(ISOR).EQ.1) THEN
  693. CALL CRTABL(IPTCHP)
  694. ipotab(isor) = IPTCHP
  695. ICHAR = LCHAIN.LECT(6+ISOR)
  696. IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR)
  697. segact MTABU*mod
  698. MTABU.MTABTI(1) = 'ENTIER'
  699. MTABU.MTABII(1) = 1
  700. MTABU.MTABTV(1) = 'MOT'
  701. MTABU.MTABIV(1) = ICHAR
  702. typret=' '
  703. CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  704. & typret,IUI,X1,CHARRE,L1,IP1)
  705.  
  706. if (CHARRE.EQ.'VITESSE') CHARRE = 'VITESSES'
  707. if span0sôyle="color: #009900;">(CHARRE.EQ.'DEPLACEMENT') CHARRE = 'DEPLACEMENTS'
  708. CALL ECCTAB(ITDYN,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  709. # 'TABLE',0,0.D0,CHARRI,.TRUE.,IPTCHP)
  710. ENDIF
  711. ENDDO
  712. segsup MTABU
  713. endif
  714. MLREEL = IPOLR(1)
  715. segact mlreel
  716. indi0 = indi1
  717.  
  718. DO ires = 1,npres
  719. indi1 = indi1 + 1
  720. xtemp1 = prog(ires)
  721. * temps calcules
  722. CALL ECCTAB(IPTEMP,'ENTIER',INDI1,0.D0,CHARRI,.TRUE.,IP0,
  723. # 'FLOTTANT',0,xtemp1,CHARRE,.TRUE.,IP1)
  724. ENDDO
  725. ENDIF
  726. * --- fin syntaxe table PASAPAS ---
  727.  
  728.  
  729. * === Cas ou l'on a demande une sortie ===
  730. IF (NRES.NE.0) THEN
  731.  
  732. * --- syntaxe table PASAPAS ---
  733. IF (LMODYN) THEN
  734. indi1 = indi0
  735. DO ires = 1,npres
  736. indi1 = indi1 + 1
  737. IVAR = 0
  738. DO isor = 1,8
  739. * champs en sortie
  740. IF (ICHRES(ISOR).EQ.1) THEN
  741. IVAR = IVAR + 1
  742. IPTCHP = ipotab(isor)
  743. ipch1 = IPORES(IVAR,IRES)
  744. CALL ECCTAB(IPTCHP,'ENTIER',INDI1,0.D0,CHARRI,.TRUE.,IP0,
  745. # 'CHPOINT',0,0.D0,CHARRE,.TRUE.,ipch1)
  746.  
  747. ENDIF
  748. ENDDO
  749. ENDDO
  750. *
  751. * --- syntaxe tables DYNE normales ---
  752. ELSE
  753. *
  754. * ISOR1 = COMBIEN DE CHPOINT? ISOR2 = COMBIEN DE LISTREEL?
  755. ISOR1=0
  756. ISOR2=0
  757. DO ISOR=1,8
  758. IF(ICHRES(ISOR).EQ.1) ISOR1=ISOR1+1
  759. IF(ICHRES(ISOR).EQ.2) ISOR2=ISOR2+1
  760. ENDDO
  761. *
  762. * 1.TRAITEMENT DES SORTIES DE TYPE LISTREEL
  763. *
  764. IF(ISOR2.GT.0) THEN
  765. IVAR = 0
  766. DO 41 ISOR = 1,8
  767. IF(ICHRES(ISOR).NE.0) IVAR = IVAR + 1
  768. IF(ICHRES(ISOR).NE.2) GOTO 41
  769. c Creation de la table de sortie de la variable
  770. M = NCRES
  771. SEGINI,MTAB1
  772. MTAB1.MLOTAB = M
  773. c avec MTAB1 . point_ref_mode_i = prog x_i(t1) ... x_i(tfin)
  774. DO INCO=1,NCRES
  775. IPLREE = IPORES(IVAR,INCO)
  776. MTAB1.MTABTI(INCO) = 'POINT'
  777. MTAB1.MTABII(INCO) = IPOREF(INCO)
  778. MTAB1.MTABTV(INCO) = 'LISTREEL'
  779. MTAB1.MTABIV(INCO) = IPLREE
  780. c write(*,*) 'devso4: IVAR',IVAR,' mode',INCO,
  781. c # ' listreel #',IPLREE
  782. ENDDO
  783. SEGDES,MTAB1
  784. c on branche cette table dans la table de sortie principale
  785. IRE2 = IRE2 + 1
  786. ICHA6= LCHAIN.LECT(6+ISOR)
  787. IF(ISOR.GT.6) ICHA6 = LCHAIN.LECT(76+ISOR)
  788. MTABTI(IRE2) = 'MOT'
  789. MTABII(IRE2) = ICHA6
  790. MTABTV(IRE2) = 'TABLE'
  791. MTABIV(IRE2) = MTAB1
  792. c write(*,*) 'devso4: sous table',MTAB1,'branchee a lindice',
  793. c # IRE2,'soit',ICHA6,' de'
  794. 41 CONTINUE
  795. ENDIF
  796. *
  797. * 2.TRAITEMENT DES SORTIES DE TYPE CHPOINT
  798. *
  799. IF(ISOR1.GT.0) THEN
  800. * boucle sur les pas de sortie
  801. DO 30 IRES = 1 , NPRES
  802. *
  803. * Creation de la table au pas de sortie IRES:
  804. M = NRES + 1
  805. SEGINI,MTAB1
  806. MTAB1.MLOTAB = M
  807. *
  808. * Sous-typage de la table au pas de sortie IRES:
  809. MTAB1.MTABTI(1) = 'MOT'
  810. ICHA6 = LCHAIN.LECT(6)
  811. MTAB1.MTABII(1) = ICHA6
  812. MTAB1.MTABTV(1) = 'MOT'
  813. ICHA2 = LCHAIN.LECT(2)
  814. MTAB1.MTABIV(1) = ICHA2
  815. *
  816. * Ecriture des CHPOINTs resultats:
  817. IVA2 = 1
  818. IVAR = 0
  819. DO 40 ISOR = 1 , 8
  820. IF (ICHRES(ISOR).NE.0) IVAR = IVAR + 1
  821. IF (ICHRES(ISOR).NE.1) GOTO 40
  822. IVA2 = IVA2 + 1
  823. MTAB1.MTABTI(IVA2) = 'MOT'
  824. ICHAR = LCHAIN.LECT(6+ISOR)
  825. * chpoints de travaux
  826. IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR)
  827. MTAB1.MTABII(IVA2) = ICHAR
  828. MTAB1.MTABTV(IVA2) = 'CHPOINT'
  829. MTAB1.MTABIV(IVA2) = IPORES(IVAR,IRES)
  830. 40 CONTINUE
  831. SEGDES,MTAB1
  832. *
  833. * Ecriture de la table au pas IRES dans la table resultat:
  834. IRE2 = IRE2 + 1
  835. MTABTI(IRE2) = 'ENTIER'
  836. MTABII(IRE2) = IRES
  837. MTABTV(IRE2) = 'TABLE'
  838. MTABIV(IRE2) = MTAB1
  839.  
  840. 30 CONTINUE
  841. ENDIF
  842.  
  843. ENDIF
  844. * --- fin syntaxe table PASAPAS / tables DYNE normales ---
  845.  
  846. ENDIF
  847. * === Fin du Cas ou l'on a demande une sortie ===
  848.  
  849. 1234 CONTINUE
  850.  
  851. *
  852. *----- CREATION DES TABLES DE LIAISONS AUX PAS DE SORTIE -----
  853. *
  854. IPTLA1 = 0
  855. IF (LMODYN) THEN
  856. IF (NLSA.NE.0.OR.NLSB.NE.0) THEN
  857. typobj = ' '
  858. CALL ACCTAB(ITDYN,'MOT',IM,X0,'LIAISONS',L0,IP0,
  859. & typobj,np,X1,CHARRE,L1,IPTLA1)
  860. if (iptla1.gt.0.and.typobj(1:8).eq.'TABLE') then
  861. call dimen7(iptla1,idimen)
  862. indi1 = idimen - 1
  863. else
  864. CALL CRTABL(IPTLA1)
  865. c* idimen = 0
  866. c* indi1 = -1
  867. CALL ECCTAB(ITDYN,'MOT',0,0.D0,'LIAISONS',.TRUE.,0,
  868. # 'TABLE',0,0.D0,CHARRE,.TRUE.,IPTLA1)
  869. ENDIF
  870. ENDIF
  871. ENDIF
  872. *
  873. MTABU = 0
  874. M = 1
  875. segini MTABU
  876. MTABU.MLOTAB = 1
  877.  
  878. *----- LIAISONS_A -----
  879. IF (NLSA.NE.0) THEN
  880. DO 50 IL = 1,NLSA
  881. *
  882. * Creation de la table pour la liaison IL :
  883. *
  884. NVAR = ICHRES(10 + IL)
  885. M = NVAR + 1
  886. SEGINI,MTAB3
  887. MTAB3.MLOTAB = M
  888. *
  889. * Sous-typage de la table pour la liaison IL :
  890. *
  891. ID = 1
  892. MTAB3.MTABTI(ID) = 'MOT'
  893. ICHA6 = LCHAIN.LECT(6)
  894. MTAB3.MTABII(ID) = ICHA6
  895. MTAB3.MTABTV(ID) = 'MOT'
  896. ICHA1 = LCHAIN.LECT(ID)
  897. MTAB3.MTABIV(ID) = ICHA1
  898. *
  899. IPTLA3 = 0
  900. IF (LMODYN) THEN
  901. itmodl = IPOLA(IL)
  902. typobj = ' '
  903. CALL ACCTAB(IPTLA1,'MMODEL ',IM,X0,CHARRE,L0,itmodl,
  904. & typobj,np,X1,CHARRI,L1,IPTLA3)
  905.  
  906. if (typobj.eq.'TABLE'.and.iptla3.gt.0) then
  907. ipta3 = 0
  908. else
  909. iptla3 = 0
  910. ipta3 = mtab3
  911. CALL ECCTAB(IPTLA1,'MMODEL ',0,0.D0,CHARRE,.TRUE.,itmodl,
  912. # 'TABLE',0,0.D0,CHARRI,.TRUE.,ipta3)
  913. endif
  914. ELSE
  915. *
  916. * Ecriture de la table de liaison dans la table resultat:
  917. *
  918. IRE2 = IRE2 + 1
  919. MTABTI(IRE2) = 'TABLE'
  920. MTABII(IRE2) = IPOLA(IL)
  921. MTABTV(IRE2) = 'TABLE'
  922. MTABIV(IRE2) = MTAB3
  923. *
  924. ENDIF
  925. *
  926. II = 0
  927. IF (IIMPI.EQ.333) THEN
  928. WRITE(IOIMP,*)'DEVSO4 : creation table liaison ',IL
  929. WRITE(IOIMP,*)'DEVSO4 : longueur table = ',M
  930. WRITE(IOIMP,*)'DEVSO4 : !!! NTVAR = ',NTVAR
  931. ENDIF
  932. DO 52 IV = 1,NTVAR
  933. IF (ILIREA(IL,IV).EQ.1) THEN
  934. II = II + 1
  935. ICHA = ILIRNA(IL,IV)
  936. MLREEL = IPLRLA(IL,II)
  937. DO 54 IRES = 1 , NPRES
  938. PROG(IRES) = XRESLA(IL,IRES,II)
  939. 54 CONTINUE
  940. ipl2 = mlreel
  941. SEGDES,MLREEL
  942. *
  943. * Ecriture de la liste de reels dans la table MTAB3 :
  944. *
  945. ID = ID + 1
  946. MTAB3.MTABTI(ID) = 'MOT'
  947. MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA)
  948. MTAB3.MTABTV(ID) = 'LISTREEL'
  949. MTAB3.MTABIV(ID) = MLREEL
  950. ENDIF
  951. 52 CONTINUE
  952. if (IPTLA3.gt.0.and.ILIREA(IL,IV).EQ.1) then
  953. ICHAR = LCHAIN.LECT(ICHA)
  954. segact MTABU*mod
  955. MTABU.MTABTI(1) = 'ENTIER'
  956. MTABU.MTABII(1) = 1
  957. MTABU.MTABTV(1) = 'MOT'
  958. MTABU.MTABIV(1) = ICHAR
  959. typret=' '
  960. CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  961. & typret,IUI,X1,CHARRE,L1,IP1)
  962. typret=' '
  963. CALL ACCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  964. # typret,0,0.D0,CHARRI,.TRUE.,IPTC3)
  965. if (typret.eq.'LISTREEL') then
  966. call fuspro(iptc3,ipl2,ipl3)
  967. CALL ECCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  968. # typret,0,0.D0,CHARRI,.TRUE.,ipl3)
  969. else if (typret.eq.'TABLE') then
  970. MTAB4 = IPTC3
  971. segact MTAB4,MTAB1
  972. M4 = MTAB4.MLOTAB
  973. do IRES = 1,NPRES
  974. ipch3 = MTAB1.MTABIV(IRES)
  975. CALL ECCTAB(IPTC3,'ENTIER',M4+IRES,0.D0,CHARRE,.TRUE.,0,
  976. # 'CHPOINT ',0,0.D0,CHARRI,.TRUE.,ipch3)
  977.  
  978. enddo
  979. segsup MTAB1
  980. segdes MTAB4
  981. else
  982. endif
  983.  
  984. endif
  985. SEGDES,MTAB3
  986. if (IPTLA3.gt.0) segsup MTAB3
  987. *
  988. 50 CONTINUE
  989. * end do
  990. ENDIF
  991.  
  992. *----- LIAISONS_B -----
  993. IF (NLSB.NE.0) THEN
  994. DO 60 IL = 1,NLSB
  995. *
  996. * Creation de la table pour la liaison IL :
  997. *
  998. NVAR = ICHRES(10 + IL + NLSA)
  999. M = NVAR + 1
  1000. SEGINI,MTAB3
  1001. MTAB3.MLOTAB = M
  1002. *
  1003. * Sous-typage de la table pour la liaison IL :
  1004. *
  1005. ID = 1
  1006. MTAB3.MTABTI(ID) = 'MOT'
  1007. ICHA6 = LCHAIN.LECT(6)
  1008. MTAB3.MTABII(ID) = ICHA6
  1009. MTAB3.MTABTV(ID) = 'MOT'
  1010. ICHA1 = LCHAIN.LECT(ID)
  1011. MTAB3.MTABIV(ID) = ICHA1
  1012. *
  1013. * Ecriture de la table de liaison dans la table resultat:
  1014. *
  1015. IPTLA3 = 0
  1016. IF (LMODYN) THEN
  1017. itmodl = IPOLB(IL)
  1018. typobj = ' '
  1019. CALL ACCTAB(IPTLA1,'MMODEL ',IM,X0,CHARRE,L0,itmodl,
  1020. & typobj,np,X1,CHARRI,L1,IPTLA3)
  1021. ipta3 = mtab3
  1022. if (typobj.eq.'TABLE'.and.iptla3.gt.0) then
  1023. else
  1024. iptla3 = 0
  1025. CALL ECCTAB(IPTLA1,'MMODEL ',0,0.D0,CHARRE,.TRUE.,itmodl,
  1026. # 'TABLE',0,0.D0,CHARRI,.TRUE.,ipta3)
  1027. endif
  1028. ELSE
  1029. IRE2 = IRE2 + 1
  1030. MTABTI(IRE2) = 'TABLE'
  1031. MTABII(IRE2) = IPOLB(IL)
  1032. MTABTV(IRE2) = 'TABLE'
  1033. MTABIV(IRE2) = MTAB3
  1034. *
  1035. ENDIF
  1036. *
  1037. II = 0
  1038. DO 62 IV = 1,NTVAR
  1039. IF (ILIREB(IL,IV).EQ.1) THEN
  1040. II = II + 1
  1041. ICHA = ILIRNB(IL,IV)
  1042.  
  1043. MLREEL = IPLRLB(IL,II)
  1044. DO 64 IRES = 1 , NPRES
  1045. PROG(IRES) = XRESLB(IL,IRES,II)
  1046. 64 CONTINUE
  1047. * end do
  1048. ipl2 = mlreel
  1049. SEGDES,MLREEL
  1050. *
  1051. * Ecriture de la liste de reels dans la table MTAB3 :
  1052. *
  1053. ID = ID + 1
  1054. MTAB3.MTABTI(ID) = 'MOT'
  1055. MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA)
  1056. MTAB3.MTABTV(ID) = 'LISTREEL'
  1057. MTAB3.MTABIV(ID) = MLREEL
  1058. ELSE
  1059. * Ecriture des chpoints dans la table MTAB1, puis de cette
  1060. * table dans la table MTAB3
  1061. IF (ILIREB(IL,IV).EQ.2) THEN
  1062. ICHA = ILIRNB(IL,IV)
  1063. MTAB1 = IPLRLB(IL,II+1)
  1064. SEGACT,MTAB1*MOD
  1065. MLENTI= IPLRLB(IL,II+2)
  1066. SEGACT,MLENTI
  1067. DO 65 IRES=1,NPRES
  1068. III=II
  1069. MCHPOI=LECT(IRES)
  1070. SEGACT MCHPOI
  1071. MSOUPO=IPCHP(1)
  1072. SEGACT,MSOUPO
  1073. MPOVAL=IPOVAL
  1074. SEGACT,MPOVAL*MOD
  1075. DO 66 IP=1,NPLB
  1076. DO 67 IDD=1,2
  1077. III=III+1
  1078. VPOCHA(IP,IDD)=XRESLB(IL,IRES,III)
  1079. 67 CONTINUE
  1080. 66 CONTINUE
  1081. SEGDES,MPOVAL,MSOUPO,MCHPOI
  1082. MTAB1.MTABIV(IRES)=MCHPOI
  1083. 65 CONTINUE
  1084. SEGSUP,MLENTI
  1085. SEGDES,MTAB1
  1086. II=III
  1087. ID = ID + 1
  1088. MTAB3.MTABTI(ID) = 'MOT'
  1089. MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA)
  1090. MTAB3.MTABTV(ID) = 'TABLE'
  1091. MTAB3.MTABIV(ID) = MTAB1
  1092. ENDIF
  1093. ENDIF
  1094. if (IPTLA3.gt.0.and.
  1095. & (ILIREB(IL,IV).EQ.1.or.ILIREB(IL,IV).EQ.2)) then
  1096. ICHAR = LCHAIN.LECT(ICHA)
  1097. segact MTABU*mod
  1098. MTABU.MTABTI(1) = 'ENTIER'
  1099. MTABU.MTABII(1) = 1
  1100. MTABU.MTABTV(1) = 'MOT'
  1101. MTABU.MTABIV(1) = ICHAR
  1102. typret=' '
  1103. CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  1104. & typret,IUI,X1,CHARRE,L1,IP1)
  1105. typret=' '
  1106. CALL ACCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  1107. # typret,0,0.D0,CHARRI,.TRUE.,IPTC3)
  1108. if (typret.eq.'LISTREEL') then
  1109. call fuspro(iptc3,ipl2,ipl3)
  1110. CALL ECCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  1111. # typret,0,0.D0,CHARRI,.TRUE.,ipl3)
  1112. else if (typret.eq.'TABLE') then
  1113. MTAB4 = IPTC3
  1114. segact MTAB4,MTAB1
  1115. M4 = MTAB4.MLOTAB
  1116. do IRES = 1,NPRES
  1117. ipch3 = MTAB1.MTABIV(IRES)
  1118. CALL ECCTAB(IPTC3,'ENTIER',M4+IRES,0.D0,CHARRE,.TRUE.,0,
  1119. # 'CHPOINT ',0,0.D0,CHARRI,.TRUE.,ipch3)
  1120.  
  1121. enddo
  1122. segsup MTAB1
  1123. segdes MTAB4
  1124. else
  1125. endif
  1126.  
  1127. endif
  1128. 62 CONTINUE
  1129. * end do
  1130. SEGDES,MTAB3
  1131. if (IPTLA3.gt.0) segsup MTAB3
  1132. 60 CONTINUE
  1133. * end do
  1134. ENDIF
  1135.  
  1136. segsup MTABU
  1137. IF (ITSORT.EQ.INDC10) THEN
  1138. if (iptla1.gt.0) THEN
  1139. MTAB1 = IPTLA1
  1140. segsup MTAB1
  1141. ENDIF
  1142. if (itdyn.gt.0) THEN
  1143. MTAB2 = ITDYN
  1144. segsup MTAB2
  1145. ITDYN = MTAB3
  1146. ENDIF
  1147. RETURN
  1148. ENDIF
  1149.  
  1150. c mise a jour de la taille de la table
  1151. M=IRE2
  1152. MLOTAB=IRE2
  1153. SEGADJ,MTABLE
  1154. SEGDES,MTABLE
  1155. *
  1156. RETURN
  1157. END
  1158.  
  1159.  
  1160.  
  1161.  
  1162.  
  1163.  
  1164.  

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