Télécharger devso4.eso

Retour à la liste

Numérotation des lignes :

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

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