Télécharger restpi.eso

Retour à la liste

Numérotation des lignes :

  1. C RESTPI SOURCE PV 16/11/26 21:16:24 9205
  2. SUBROUTINE RESTPI (ICOLAC)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C RESTAURATION DES POINTEURS
  7. C
  8. C PROGRAMME PAR FARVACQUE
  9. C APPELE PAR SAUV
  10. C APPELLE : ERREUR
  11. C
  12. C HISTORIQUE : ajout des objets de type MATRAK et MATRIK par
  13. C GOUNAND (15/07/98)
  14. C
  15. C=======================================================================
  16. C TABLEAU KCOLA: VOIR LE SOUS-PROGRAMME TYPFIL
  17. C=======================================================================
  18. -INC CCNOYAU
  19. -INC CCOPTIO
  20. -INC CCASSIS
  21.  
  22. CINC SMELEME
  23. -INC SMBASEM
  24. CINC SMCHPOI
  25. CINC SMRIGID
  26. -INC SMMATRI
  27. -INC SMELSTR
  28. -INC SMCLSTR
  29. -INC SMSTRUC
  30. -INC SMATTAC
  31. -INC SMSOLUT
  32. -INC SMLENTI
  33. -INC SMLREEL
  34. -INC SMDEFOR
  35. -INC SMCHARG
  36. -INC SMEVOLL
  37. -INC SMTABLE
  38. -INC SMSUPER
  39. -INC SMVECTE
  40. -INC SMLCHPO
  41. -INC SMINTE
  42. CINC SMNUAGE
  43. -INC TMCOLAC
  44.  
  45. CHARACTER*(8) ITYPE
  46. SEGACT ICOLAC
  47. NITLAC=ICOLA(/1)
  48. C
  49. C****** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC******************
  50. C
  51. DO 1099 IFILE=1,NITLAC
  52. ITLACC=KCOLA(IFILE)
  53. IMAX1=ITLAC(/1)
  54. IDEB=KCOLAC(IFILE)+1
  55. IF(IMAX1.EQ.0.OR.IDEB.GT.IMAX1) GO TO 1099
  56. C ITLACC=KCOLA(IFILE)
  57. GO TO (6001,6002,6003,1099,1099,6006,6007,6008, 509,510,1099
  58. 1 ,512,6013,6014,6015,6016,6017,6018,6019,6020,1099,6022
  59. 1 ,6023,6024,6025,6026,6027,6028,6029,6030,6031,6032,6033
  60. 1 ,534 ,6035,1098,1098,6038,6039,6040,6041,6042
  61. 1 ,6043,510,1099 ),IFILE
  62. C ----
  63. 1001 ITYPE=' '
  64. CALL TYPFIL (ITYPE,IFILE)
  65. MOTERR(1:8)=ITYPE
  66. CALL ERREUR (336)
  67. GO TO 1099
  68. C ****************************** MELEME ****************************
  69. 6001 CONTINUE
  70. CALL RESTME (ITLACC,IMAX1,ICOLAC,IDEB)
  71. GOTO 1098
  72. C **************************CHPOINT*********************************
  73. 6002 CONTINUE
  74. CALL RESTCH (ICOLAC,ITLACC,IMAX1,IDEB)
  75. GOTO 1098
  76. C ***********************MRIGID*************************************
  77. 6003 CONTINUE
  78. CALL RESTRI (ICOLAC,ITLACC,IMAX1,IDEB)
  79. GOTO 1098
  80. C *************************** *******************************
  81. 6004 CONTINUE
  82. GOTO 1098
  83. C *************************** *******************************
  84. 6005 CONTINUE
  85. GOTO 1098
  86. C **************************** MCLSTR ******************************
  87. 6006 CONTINUE
  88. ITLAC1=KCOLA(12)
  89. ITLAC3=KCOLA(3)
  90. DO 614 IEL=IDEB,IMAX1
  91. MCLSTR=ITLAC(IEL)
  92. IF (MCLSTR.EQ.0) GO TO 614
  93. SEGACT MCLSTR*MOD
  94. N=ISOSTR(/1)
  95. DO 615 I=1,N
  96. IVA=ISOSTR(I)
  97. IF (IVA.NE.0)ISOSTR(I)=ITLAC1.ITLAC(IVA)
  98. IVA=IRIGCL(I)
  99. IF (IVA.NE.0)IRIGCL(I)=ITLAC3.ITLAC(I)
  100. 615 CONTINUE
  101. SEGDES MCLSTR
  102. 614 CONTINUE
  103. GO TO 1098
  104. C **************************** MELSTR ******************************
  105. 6007 CONTINUE
  106. ITLAC2=KCOLA(12)
  107. ITLAC1=KCOLA(1)
  108. DO 616 IEL=IDEB,IMAX1
  109. MELSTR=ITLAC(IEL)
  110. IF (MELSTR.EQ.0) GO TO 616
  111. SEGACT MELSTR*MOD
  112. N=ISOSTU(/1)
  113. DO 617 I=1,N
  114. IVA=ISOSTU(I)
  115. IF(IVA.NE.0)ISOSTU(I)=ITLAC2.ITLAC(I)
  116. IVA=IMELEM(I)
  117. IF(IVA.NE.0)IMELEM(I)=ITLAC1.ITLAC(IVA)
  118. 617 CONTINUE
  119. SEGDES MELSTR
  120. 616 CONTINUE
  121. GO TO 1098
  122. C ****************************MSOLUT********************************
  123. 6008 CONTINUE
  124. DO 1800 IEL=IDEB,IMAX1
  125. MSOLUT=ITLAC(IEL)
  126. IF (MSOLUT.EQ.0) GO TO 1800
  127. SEGACT MSOLUT*MOD
  128. IF (IONIVE.GE.3) GO TO 818
  129. C ANCIEN NIVEAU------------------
  130. IF(MSOLIS(3).LE.0) GOTO 1802
  131. ITLAC1=KCOLA(1)
  132. IVA=MSOLIS(3)
  133. IF (IVA.NE.0) MSOLIS(3)=ITLAC1.ITLAC(IVA)
  134. GOTO 1803
  135. 1802 CONTINUE
  136. MSOLIS(3)=-MSOLIS(3)
  137. 1803 CONTINUE
  138. GO TO 817
  139. C FIN ANCIEN NIVEAU------------------
  140. 818 NIPO=MSOLIS(/1)
  141. DO 620 II=1,NIPO
  142. IF(MSOLIS(II).EQ.0) GOTO 620
  143. IF(II.EQ.3) THEN
  144. IVA=MSOLIS(3)
  145. ITLAC1= KCOLA(1)
  146. IF(IVA.NE.0) MSOLIS(3)=ITLAC1.ITLAC(IVA)
  147. GOTO 620
  148. ENDIF
  149. IF(II.LE.4) GOTO 620
  150. ITLAC2=KCOLA(MSOLIT(II))
  151. MSOLEN=MSOLIS(II)
  152. SEGACT MSOLEN*MOD
  153. LTAB=ISOLEN(/1)
  154. DO 619 I=1,LTAB
  155. IVA=ISOLEN(I)
  156. IF (IVA.NE.0) ISOLEN(I)=ITLAC2.ITLAC(IVA)
  157. 619 CONTINUE
  158. SEGDES MSOLEN
  159. 620 CONTINUE
  160. 817 SEGDES MSOLUT
  161. 1800 CONTINUE
  162. GOTO 1098
  163. C ************************** MSTRUC ********************************
  164. 509 CONTINUE
  165. ITLAC1=KCOLA(12)
  166. DO 621 IEL=IDEB,IMAX1
  167. MSTRUC=ITLAC(IEL)
  168. IF (MSTRUC.EQ.0) GO TO 621
  169. SEGACT MSTRUC*MOD
  170. N=LISTRU(/1)
  171. DO 622 I=1,N
  172. IVA=ABS(LISTRU(I))
  173. * IF (IVA.NE.0)LISTRU(I)=ITLAC1.ITLAC(IVA) MILL 3 / 9 / 92
  174. IF (LISTRU(I).LT.0)LISTRU(I)=ITLAC1.ITLAC(IVA)
  175. 622 CONTINUE
  176. SEGDES MSTRUC
  177. 621 CONTINUE
  178. GOTO 1098
  179. C ******************************* MTABLE **************************
  180. 510 CONTINUE
  181. ITLAC2=KCOLA(27)
  182. NTOTO=6
  183. if(nbesc.ne.0) segact ipiloc
  184. DO 710 IEL=IDEB,IMAX1
  185. MTABLE=ITLAC(IEL)
  186. IF (MTABLE.EQ.0) GO TO 710
  187. SEGACT MTABLE*MOD
  188. L6=MLOTAB
  189. L=L6
  190.  
  191. IF (L.EQ.0) GO TO 713
  192. DO 711 K=1,L
  193. ITYPE=MTABTI(K)
  194. IVA=MTABII(K)
  195. CALL TYPFIL (ITYPE,J)
  196. IF(J.LE.0) GO TO 711
  197. ITLAC1=KCOLA(J)
  198. MTABII(K)=ITLAC1.ITLAC(IVA)
  199. IF(MTABTI(K).EQ.'METHODE ') MTABII(K)=ITLAC2
  200. $ .ITLAC(MTABII(K))
  201. IF (ITYPE.EQ.'FLOTTANT') RMTABI(K)=XIFLOT(MTABII(K))
  202. C-----SI ON POINTE SUR UNE TABLE IL NE FAUT PAS DESACTIVER
  203. ITYPE=MTABTV(K)
  204. IVA=MTABIV(K)
  205. CALL TYPFIL (ITYPE,J)
  206. IF(J.LE.0) GO TO 711
  207. IF(J.eq.47) GO TO 711
  208. ITLAC1=KCOLA(J)
  209. MTABIV(K)=ITLAC1.ITLAC(IVA)
  210. IF (ITYPE.EQ.'FLOTTANT') RMTABV(K)=XIFLOT(MTABIV(K))
  211. C-----SI ON POINTE SUR UNE TABLE IL NE FAUT PAS DESACTIVER
  212. 711 CONTINUE
  213. 713 SEGDES MTABLE
  214. 710 CONTINUE
  215. if(nbesc.ne.0) segdes ipiloc
  216. GO TO 1098
  217. 715 CONTINUE
  218. MOTERR(1:8)=ITYPE
  219. CALL ERREUR (336)
  220. GO TO 1098
  221. C ***************************** *****************************
  222. 6011 CONTINUE
  223. GOTO 1098
  224. C ******************************** MSOSTU **************************
  225. 512 CONTINUE
  226. ITLAC1=KCOLA(5)
  227. ITLAC3=KCOLA(3)
  228. DO 630 IEL=IDEB,IMAX1
  229. MSOSTU=ITLAC(IEL)
  230. IF (MSOSTU.EQ.0) GO TO 630
  231. SEGACT MSOSTU*MOD
  232. IVA=ISRAID
  233. IF(IVA.NE.0)ISRAID=ITLAC3.ITLAC(IVA)
  234. IVA=ISMASS
  235. IF(IVA.NE.0)ISMASS=ITLAC3.ITLAC(IVA)
  236. NS=ISCHAM(/1)
  237. DO 121 I=1,NS
  238. IVA= ISCHAM(I)
  239. IF (IVA.NE.0)ISCHAM(I)= ITLAC1.ITLAC(IVA)
  240. 121 CONTINUE
  241. SEGDES MSOSTU
  242. 630 CONTINUE
  243. GO TO 1098
  244. C ***************************** IMATRI *****************************
  245. 6013 CONTINUE
  246. GOTO 1098
  247. C ***************************** MJONCT *****************************
  248. 6014 CONTINUE
  249. ITLAC1=KCOLA(1)
  250. ITLAC2=KCOLA(2)
  251. ITLAC3=KCOLA(12)
  252. DO 631 IEL=IDEB,IMAX1
  253. MJONCT=ITLAC(IEL)
  254. IF (MJONCT.EQ.0) GO TO 631
  255. SEGACT MJONCT*MOD
  256. IVA=MJOPOI
  257. CCCC MJOPOI=ITLAC1.ITLAC(IVA)
  258. IF(MJOTYP.EQ.'CHOC') THEN
  259. IF(IVA.NE.0) MJOPOI=ITLAC2.ITLAC(IVA)
  260. ELSE
  261. IF(IVA.NE.0) MJOPOI=ITLAC1.ITLAC(IVA)
  262. ENDIF
  263. DO 632 I=1,ISTRJO(/1)
  264. IVA=ISTRJO(I)
  265. IF (IVA.NE.0)ISTRJO(I)= ITLAC3.ITLAC(IVA)
  266. IVA=IPCHJO(I)
  267. IF (IVA.NE.0)IPCHJO(I)=ITLAC2.ITLAC(IVA)
  268. IVA=IPOSJO(I)
  269. IF (IVA.NE.0) IPOSJO(I)= ITLAC1.ITLAC(IVA)
  270. 632 CONTINUE
  271. SEGDES MJONCT
  272. 631 CONTINUE
  273. GO TO 1098
  274. C ************************ MATTAC **********************************
  275. 6015 CONTINUE
  276. ITLAC1=KCOLA(1)
  277. ITLAC3=KCOLA(3)
  278. ITLAC4=KCOLA(14)
  279. DO 150 IEL=IDEB,IMAX1
  280. MATTAC =ITLAC(IEL)
  281. IF (MATTAC.EQ.0) GO TO 150
  282. SEGACT MATTAC*MOD
  283. NN=LISATT(/1)
  284. DO 151 I=1,NN
  285. MSOUMA=LISATT(I)
  286. SEGACT MSOUMA*MOD
  287. N=IPMATK(/1)
  288. DO 152 J=1,N
  289. IVA=IPMATK(J)
  290. IF (IVA.NE.0)IPMATK(J)= ITLAC3.ITLAC(IVA)
  291. 152 CONTINUE
  292. N=IATREL(/1)
  293. DO 153 J=1,N
  294. IVA=IATREL(J)
  295. IF (IVA.NE.0)IATREL(J)=ITLAC4.ITLAC(IVA)
  296. 153 CONTINUE
  297. IF(IGEOCH.EQ.0) GO TO 156
  298. MGEOCH=IGEOCH
  299. SEGACT MGEOCH*MOD
  300. NI=INORCH(/1)
  301. DO 154 J=1,NI
  302. IVA=INORCH(J)
  303. IF (IVA.NE.0)INORCH(J)= ITLAC1.ITLAC(IVA)
  304. 154 CONTINUE
  305. N1=IMAPRO(/1)
  306. DO 155 J=1,N1
  307. IVA=IMAPRO(J)
  308. IF (IVA.NE.0)IMAPRO(J)= ITLAC1.ITLAC(IVA)
  309. 155 CONTINUE
  310. SEGDES MGEOCH
  311. 156 CONTINUE
  312. SEGDES MSOUMA
  313. 151 CONTINUE
  314. SEGDES MATTAC
  315. 150 CONTINUE
  316. GOTO 1098
  317. C ***************************** MMATRI *****************************
  318. 6016 CONTINUE
  319. ITLAC1=KCOLA(1)
  320. DO 2600 IEL=IDEB,IMAX1
  321. MMATRI=ITLAC(IEL)
  322. IF (MMATRI.EQ.0) GO TO 2600
  323. SEGACT MMATRI*MOD
  324. IVA=IGEOMA
  325. IGEOMA=ITLAC1.ITLAC(IVA)
  326. SEGDES MMATRI
  327. 2600 CONTINUE
  328. GOTO 1098
  329. C ************************* MDEFOR*******************************
  330. 6017 CONTINUE
  331. ITLAC1=KCOLA(1)
  332. ITLAC2=KCOLA(2)
  333. ITLAC3=KCOLA(30)
  334. ITLAC4=KCOLA(38)
  335. ITLAC5=KCOLA(39)
  336. DO 2700 IEL=IDEB,IMAX1
  337. MDEFOR=ITLAC(IEL)
  338. IF (MDEFOR.EQ.0) GO TO 2700
  339. SEGACT MDEFOR*MOD
  340. NDEF=IELDEF(/1)
  341. DO 2701 I=1,NDEF
  342. IVA=IELDEF(I)
  343. IELDEF(I)=ITLAC1.ITLAC(IVA)
  344. IVA=ICHDEF(I)
  345. ICHDEF(I)=ITLAC2.ITLAC(IVA)
  346. IVA=MTVECT(I)
  347. IF (IVA.NE.0) MTVECT(I)=ITLAC3.ITLAC(IVA)
  348. IVA=MDCHP(I)
  349. IF (IVA.NE.0) MDCHP(I)=ITLAC2.ITLAC(IVA)
  350. IVA=MDCHEL(I)
  351. IF (IVA.NE.0) MDCHEL(I)=ITLAC5.ITLAC(IVA)
  352. IVA=MDMODE(I)
  353. IF (IVA.NE.0) MDMODE(I)=ITLAC4.ITLAC(IVA)
  354. 2701 CONTINUE
  355. SEGDES MDEFOR
  356. 2700 CONTINUE
  357. GOTO 1098
  358. C ***************************MLREEL******************************
  359. 6018 CONTINUE
  360. GOTO 1098
  361. C *****************************MLENTI***************************
  362. 6019 CONTINUE
  363. GOTO 1098
  364. C ****************************MCHARG*****************************
  365. 6020 CONTINUE
  366. ITLAC1=KCOLA(2)
  367. ITLAC2=KCOLA(18)
  368. ITLAC3=KCOLA(39)
  369. ITLAC4=KCOLA(10)
  370. ITLAC5=KCOLA(32)
  371. ITLAC6=KCOLA(1)
  372. DO 3000 IEL=IDEB,IMAX1
  373. MCHARG=ITLAC(IEL)
  374. SEGACT MCHARG
  375. IF (MCHARG.EQ.0) GO TO 3000
  376. N=KCHARG(/1)
  377. DO 3001 I=1,N
  378. ICHARG=KCHARG(I)
  379. SEGACT ICHARG*MOD
  380. IF(CHATYP.EQ.'CHPOINT ') THEN
  381. IVA=ABS(ICHPO1)
  382. IF(ICHPO1.LT.0) ICHPO1=ITLAC1.ITLAC(IVA)
  383. IVA=ABS(ICHPO2)
  384. IF(ICHPO2.LT.0) ICHPO2=ITLAC2.ITLAC(IVA)
  385. IVA=ABS(ICHPO3)
  386. IF(ICHPO3.LT.0) ICHPO3=ITLAC2.ITLAC(IVA)
  387. ELSE IF (CHATYP.EQ.'MCHAML ') THEN
  388. IVA=ABS(ICHPO1)
  389. IF(ICHPO1.LT.0) ICHPO1=ITLAC3.ITLAC(IVA)
  390. IVA=ABS(ICHPO2)
  391. IF(ICHPO2.LT.0) ICHPO2=ITLAC2.ITLAC(IVA)
  392. IVA=ABS(ICHPO3)
  393. IF(ICHPO3.LT.0) ICHPO3=ITLAC2.ITLAC(IVA)
  394. ELSE IF (CHATYP.EQ.'TABLE ') THEN
  395. IVA=ABS(ICHPO1)
  396. IF(ICHPO1.LT.0) ICHPO1=ITLAC4.ITLAC(IVA)
  397. IVA=ABS(ICHPO2)
  398. IF(ICHPO2.LT.0) ICHPO2=ITLAC4.ITLAC(IVA)
  399. ENDIF
  400. IF(CHAMOB(I).EQ.'TRAN') THEN
  401. IVA=ABS(ICHPO4)
  402. IF(ICHPO4.LT.0) ICHPO4=ITLAC5.ITLAC(IVA)
  403. IVA=ABS(ICHPO6)
  404. IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA)
  405. IVA=ABS(ICHPO7)
  406. IF(ICHPO7.LT.0) ICHPO7=ITLAC2.ITLAC(IVA)
  407. ELSEIF(CHAMOB(I).EQ.'ROTA') THEN
  408. IVA=ABS(ICHPO4)
  409. IF(ICHPO4.LT.0) ICHPO4=ITLAC5.ITLAC(IVA)
  410. IVA=ABS(ICHPO5)
  411. IF(ICHPO5.LT.0.AND.IDIM.GT.2) ICHPO5=ITLAC5.ITLAC(IVA)
  412. IVA=ABS(ICHPO6)
  413. IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA)
  414. IVA=ABS(ICHPO7)
  415. IF(ICHPO7.LT.0) ICHPO7=ITLAC2.ITLAC(IVA)
  416. ELSEIF(CHAMOB(I).EQ.'TRAJ') THEN
  417. IVA=ABS(ICHPO4)
  418. IF(ICHPO4.LT.0) ICHPO4=ITLAC1.ITLAC(IVA)
  419. IVA=ABS(ICHPO5)
  420. IF(ICHPO5.LT.0) ICHPO5=ITLAC6.ITLAC(IVA)
  421. IVA=ABS(ICHPO6)
  422. IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA)
  423. ENDIF
  424. SEGDES ICHARG
  425. 3001 CONTINUE
  426. SEGDES MCHARG
  427. 3000 CONTINUE
  428. GOTO 1098
  429. C ************************ *****************************
  430. 6021 CONTINUE
  431. GOTO 1098
  432. C *********************MEVOLL************************************
  433. 6022 CONTINUE
  434. ITLACR=KCOLA(18)
  435. ITLACM=KCOLA(29)
  436. ITLAC2=ITLACR
  437. ITLAC2=ITLACM
  438. DO 3200 IEL=IDEB,IMAX1
  439. MEVOLL=ITLAC(IEL)
  440. IF (MEVOLL.EQ.0) GO TO 3200
  441. SEGACT MEVOLL
  442. N=IEVOLL(/1)
  443. DO 3201 I=1,N
  444. KEVOLL=IEVOLL(I)
  445. SEGACT KEVOLL*MOD
  446. IVA=ABS(IPROGX)
  447. IF(IONIVE.GE.3) THEN
  448. IF(TYPX.EQ.'LISTMOTS') THEN
  449. ITLAC2=ITLACM
  450. ELSEIF(TYPX.EQ.'LISTREEL') THEN
  451. ITLAC2=ITLACR
  452. ENDIF
  453. ENDIF
  454. * IPROGX=ITLAC2.ITLAC(IVA) MILL 3 / 9 /92
  455. IF(IPROGX.LT.0) IPROGX=ITLAC2.ITLAC(IVA)
  456. IVA=ABS(IPROGY)
  457. IF(IONIVE.GE.3) THEN
  458. IF(TYPY.EQ.'LISTMOTS') THEN
  459. ITLAC2=ITLACM
  460. ELSEIF(TYPY.EQ.'LISTREEL') THEN
  461. ITLAC2=ITLACR
  462. ENDIF
  463. ENDIF
  464. * IPROGY=ITLAC2.ITLAC(IVA) MILL 3 / 9 / 92
  465. IF(IPROGY.LT.0) IPROGY=ITLAC2.ITLAC(IVA)
  466. SEGDES KEVOLL
  467. 3201 CONTINUE
  468. SEGDES MEVOLL
  469. 3200 CONTINUE
  470. ITLAC2=ITLACR
  471. ITLAC2=ITLACM
  472. GOTO 1098
  473. C **********************SUPERELE************************************
  474. 6023 CONTINUE
  475. ITLAC1=KCOLA(1)
  476. ITLAC3=KCOLA(3)
  477. ITLAC2=KCOLA( 2)
  478. ITLAC4=KCOLA(16)
  479. DO 5230 IEL=IDEB,IMAX1
  480. MSUPER=ITLAC(IEL)
  481. IF (MSUPER.EQ.0) GO TO 5230
  482. SEGACT MSUPER*MOD
  483. IVA=MRIGTO
  484. MRIGTO=ITLAC3.ITLAC(IVA)
  485. IVA=MSUPEL
  486. MSUPEL=ITLAC1.ITLAC(IVA)
  487. IVA=MSURAI
  488. MSURAI=ITLAC3.ITLAC(IVA)
  489. IVA=MCROUT
  490. if (iva.le.ITLAC4.ITLAC(/1)) then
  491. MCROUT=ITLAC4.ITLAC(IVA)
  492. else
  493. MCROUT=0
  494. endif
  495. IVA=MSUMAS
  496. IF (IVA.NE.0) MSUMAS=ITLAC3.ITLAC(IVA)
  497. SEGDES MSUPER
  498. 5230 CONTINUE
  499. GOTO 1098
  500. C **********************LOGIQUE***********************************
  501. 6024 CONTINUE
  502. GOTO 1098
  503. C **********************FLOTTANT**********************************
  504. 6025 CONTINUE
  505. GOTO 1098
  506. C ********************** ENTIER **********************************
  507. 6026 CONTINUE
  508. GOTO 1098
  509. C ********************** MOT ***********************************
  510. 6027 CONTINUE
  511. GOTO 1098
  512. C ********************** TEXTE ***********************************
  513. 6028 CONTINUE
  514. GOTO 1098
  515. C ********************** LISTMOTS*********************************
  516. 6029 CONTINUE
  517. GOTO 1098
  518. C ********************** VECTEUR**********************************
  519. 6030 CONTINUE
  520. ITLAC1=KCOLA(1)
  521. ITLAC2=KCOLA( 2)
  522. DO 5300 IEL=IDEB,IMAX1
  523. MVECTE=ITLAC(IEL)
  524. IF (MVECTE.EQ.0) GO TO 5300
  525. SEGACT MVECTE*MOD
  526. NVEC=ICHPO(/1)
  527. DO 5301 I=1,NVEC
  528. * PAS UTILISE ACTUELLEMENT
  529. * IVA=IGEOV(I)
  530. * IGEOV(I)=ITLAC1.ITLAC(IVA)
  531. IVA=ICHPO(I)
  532. ICHPO(I)=ITLAC2.ITLAC(IVA)
  533. 5301 CONTINUE
  534. SEGDES MVECTE
  535. 5300 CONTINUE
  536. GOTO 1098
  537. C ********************** VECTDOUB*********************************
  538. 6031 CONTINUE
  539. GOTO 1098
  540. C ********************** POINT *********************************
  541. 6032 CONTINUE
  542. GOTO 1098
  543. C ********************** CONFIG *********************************
  544. 6033 CONTINUE
  545. GOTO 1098
  546. C *********************** LISTCHPO ******************************
  547. 534 CONTINUE
  548. ITLAC2=KCOLA(2)
  549. DO 340 IEL=IDEB,IMAX1
  550. MLCHPO =ITLAC(IEL)
  551. IF (MLCHPO.EQ.0) GO TO 340
  552. SEGACT MLCHPO*MOD
  553. N1=ICHPOI(/1)
  554. DO 341 I=1,N1
  555. IVA=ICHPOI(I)
  556. ICHPOI(I)=ITLAC2.ITLAC(IVA)
  557. 341 CONTINUE
  558. SEGDES MLCHPO
  559. 340 CONTINUE
  560. GO TO 1098
  561. C ************************** BASEM ********************************
  562. 6035 CONTINUE
  563. ITLAC1=KCOLA(12)
  564. ITLAC2=KCOLA(8 )
  565. ITLAC3=KCOLA(15)
  566. DO 350 IEL=IDEB,IMAX1
  567. MBASEM=ITLAC(IEL)
  568. IF (MBASEM.EQ.0) GO TO 350
  569. SEGACT MBASEM
  570. N=LISBAS(/1)
  571. IF (N.EQ.0) GO TO 352
  572. DO 351 I=1,N
  573. MSOBAS=LISBAS(I)
  574. SEGACT MSOBAS*MOD
  575. IVA=ABS(IBSTRM(1))
  576. * IBSTRM(1)=ITLAC1.ITLAC(IVA) MILL 3 / 9 /92
  577. IF(IBSTRM(1).LT.0) IBSTRM(1)=ITLAC1.ITLAC(IVA)
  578. IVA=ABS(IBSTRM(2))
  579. * IBSTRM(2)=ITLAC2.ITLAC(IVA)
  580. IF(IBSTRM(2).LT.0) IBSTRM(2)=ITLAC2.ITLAC(IVA)
  581. IVA=ABS(IBSTRM(3))
  582. * IBSTRM(3)=ITLAC2.ITLAC(IVA)
  583. IF(IBSTRM(3).LT.0) IBSTRM(3)=ITLAC2.ITLAC(IVA)
  584. 353 CONTINUE
  585. IVA=ABS(IBSTRM(4))
  586. * IBSTRM(4)=ITLAC3.ITLAC(IVA)
  587. IF(IBSTRM(4).LT.0) IBSTRM(4)=ITLAC3.ITLAC(IVA)
  588. 354 CONTINUE
  589. IVA=ABS(IBSTRM(5))
  590. * IBSTRM(5)=ITLAC2.ITLAC(IVA)
  591. IF(IBSTRM(5).LT.0) IBSTRM(5)=ITLAC2.ITLAC(IVA)
  592. 355 CONTINUE
  593. SEGDES MSOBAS
  594. 351 CONTINUE
  595. 352 SEGDES MBASEM
  596. 350 CONTINUE
  597. GOTO 1098
  598. C ************************ MMODEL **********************************
  599. 6038 CONTINUE
  600. CALL RESMMO(ICOLAC,ITLACC,IMAX1,IDEB)
  601. GOTO 1098
  602. C ************************ MCHAML **********************************
  603. 6039 CONTINUE
  604. CALL RESCHA(ICOLAC,ITLACC,IMAX1,IDEB)
  605. GOTO 1098
  606. C ************************ MINTE **********************************
  607. 6040 CONTINUE
  608. GOTO 1098
  609. C ************************ MNUAGE ******************************
  610. 6041 CONTINUE
  611. CALL RESNUA(ICOLAC,ITLACC,IMAX1)
  612. GOTO 1098
  613. C ************************* MATRAK *********************************
  614. 6042 CONTINUE
  615. CALL RESMAK(ICOLAC,ITLACC,IMAX1,IDEB)
  616. GOTO 1098
  617. C ************************* MATRIK ********************************
  618. 6043 CONTINUE
  619. CALL RESMIK(ICOLAC,ITLACC,IMAX1,IDEB)
  620. GOTO 1098
  621. C ************************ ******************************
  622. 6045 CONTINUE
  623. GO TO 1098
  624. C ******************************************************************
  625. 1098 CONTINUE
  626. C*********************************************************************
  627. 1099 CONTINUE
  628. SEGDES ICOLAC
  629. C
  630. RETURN
  631. END
  632.  
  633.  
  634.  
  635.  
  636.  
  637.  
  638.  
  639.  

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