Télécharger expil.eso

Retour à la liste

Numérotation des lignes :

  1. C EXPIL SOURCE PV 17/10/03 21:15:25 9581
  2. SUBROUTINE EXPIL (IFILE,ICOLAC,M1,M2,IIICHA)
  3. C----------------------------------------------------------------------
  4. C
  5. C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DE LA PILE
  6. C SI IIICHA =1 ON CHANGE LES POINTEURS----
  7. C
  8. C ENTREE IFILE NUMERO DE LA PILE EXAMINEE
  9. C ICOLAC POINTEUR SUR LE CHAPEAU DES PILES
  10. C M1 PREMIER INDICE D EXAMEN DANS LA PILE
  11. C M2 DERNIER INDICE
  12. C IIICHA =1 ON CHANGE LES POINTEURS
  13. C-----------------------------------------------------------------------
  14. C REMARQUE : ICOLAC EST UN SEGMENT ACTIF EN ENTREE ET EN SORTIE
  15. C PAS DE CHANGEMENT DE STATUT AU COURS DU SP
  16. C-----------------------------------------------------------------------
  17. C PROGRAMME PAR FARVACQUE- REPRIS PAR LENA
  18. C APPELE PAR FILLPI
  19. C APPELLE AJOUN TYPFIL
  20. C=======================================================================
  21. C TABLEAU KCOLA : VOIR LE SOUS-PROGRAMME TYPFIL
  22. C=======================================================================
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25. -INC CCOPTIO
  26. -INC CCASSIS
  27.  
  28. *INC SMELEME
  29. -INC SMBASEM
  30. *INC SMCHPOI
  31. *INC SMRIGID
  32. -INC SMMATRI
  33. -INC SMCLSTR
  34. -INC SMELSTR
  35. -INC SMSOLUT
  36. -INC SMDEFOR
  37. -INC SMSTRUC
  38. -INC SMATTAC
  39. -INC SMCHARG
  40. -INC SMMODEL
  41. -INC SMEVOLL
  42. -INC SMTABLE
  43. -INC SMSUPER
  44. -INC SMTEXTE
  45. -INC SMVECTE
  46. -INC SMLCHPO
  47. -INC SMINTE
  48. -INC SMNUAGE
  49. -INC TMCOLAC
  50.  
  51. SEGMENT ITRAVV(NITLAC)
  52. CHARACTER*(8) ITYP1
  53. CHARACTER*(1) CHAVAL
  54. CHARACTER*(16) MOTYP
  55. C=======================================================================
  56. C ICOLAC : KCOLA : POINTEUR SUR LA PILE ITLACC
  57. C MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  58. C ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  59. C KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A SORT
  60. C=======================================================================
  61. IF (M1.GT.M2) RETURN
  62. IF (IIMPI.EQ.5) WRITE (IOIMP,8877) IFILE,M1,M2
  63. 8877 FORMAT (' EXAMEN DE LA PILE ',I5,' DE',I5,' A',I5)
  64. SEGACT ICOLAC
  65. ILISSE=ILISSG
  66. SEGACT ILISSE*MOD
  67. ITLACC=KCOLA(IFILE)
  68. GO TO(501,502,503,599,599,506,507,508,509,510,
  69. 1 599,512,599,514,515,516,517,599,599,520,
  70. 1 599,522,523,524,525,526,527,528,529,530,
  71. 1 531,532,533,534,535,599,599,538,539,540,
  72. 1 541,542,543,510,545,546,547,548),IFILE
  73. CALL TYPFIL(MOTERR,IFILE)
  74. CALL ERREUR (336)
  75. CALL GINT2
  76. GO TO 599
  77. C ******************************* MELEME****************************
  78. 501 CONTINUE
  79. CALL EXAMEL (ICOLAC,ITLACC,M1,M2,IIICHA)
  80. GO TO 599
  81. C **************************** MCHPOI ******************************
  82. 502 CONTINUE
  83. CALL EXACHP (ICOLAC,ITLACC,M1,M2,IIICHA)
  84. GO TO 599
  85. C **************************** MRIGID ******************************
  86. 503 CONTINUE
  87. CALL EXARIG (ICOLAC,ITLACC,M1,M2,IIICHA)
  88. GO TO 599
  89. C *************************** *******************************
  90. 504 CONTINUE
  91. GO TO 599
  92. C *************************** *******************************
  93. 505 CONTINUE
  94. GO TO 599
  95. C **************************** MCLSTR ******************************
  96. 506 CONTINUE
  97. ICO1=KCOLA(12)
  98. ICO2=KCOLA(3)
  99. DO 614 IEL=M1,M2
  100. MCLSTR=ITLAC(IEL)
  101. IF (MCLSTR.EQ.0) GO TO 614
  102. SEGACT MCLSTR*MOD
  103. DO 615 I=1,ISOSTR(/1)
  104. IVA=ISOSTR(I)
  105. IF(IVA.NE.0)CALL AJOUN(ICO1,IVA,ILISSE,1)
  106. IF(IIICHA.EQ.1)ISOSTR(I)=IVA
  107. IVA=IRIGCL(I)
  108. IF (IVA.NE.0)CALL AJOUN(ICO2,IVA,ILISSE,1)
  109. IF(IIICHA.EQ.1)IRIGCL(I)=IVA
  110. 615 CONTINUE
  111. SEGDES MCLSTR
  112. 614 CONTINUE
  113. GO TO 599
  114. C **************************** MELSTR ******************************
  115. 507 CONTINUE
  116. ICO1=KCOLA(12)
  117. ICO2=KCOLA(1)
  118. DO 616 IEL=M1,M2
  119. MELSTR=ITLAC(IEL)
  120. IF (MELSTR.EQ.0) GO TO 616
  121. SEGACT MELSTR*MOD
  122. DO 617 I=1,ISOSTU(/1)
  123. IVA=ISOSTU(I)
  124. IF(IVA.NE.0)CALL AJOUN(ICO1,IVA,ILISSE,1)
  125. IF(IIICHA.EQ.1)ISOSTU(I)=IVA
  126. IVA=IMELEM(I)
  127. IF (IVA.NE.0)CALL AJOUN(ICO2,IVA,ILISSE,1)
  128. IF(IIICHA.EQ.1)IMELEM(I)=IVA
  129. 617 CONTINUE
  130. SEGDES MELSTR
  131. 616 CONTINUE
  132. GO TO 599
  133. C *************************** MSOLUT *******************************
  134. 508 CONTINUE
  135. ICO1=KCOLA(1)
  136. DO 618 IEL=M1,M2
  137. MSOLUT=ITLAC(IEL)
  138. IF (MSOLUT.EQ.0) GO TO 618
  139. SEGACT MSOLUT*MOD
  140. 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. CALL AJOUN(ICO1,IVA,ILISSE,1)
  146. CCC IF (IONIVE.LT.3) GO TO 620
  147. IF(IIICHA.EQ.1) MSOLIS(3)=IVA
  148. GOTO 620
  149. ENDIF
  150. IF(II.LE.4) GOTO 620
  151. ICO2=KCOLA(MSOLIT(II))
  152. MSOLEN=MSOLIS(II)
  153. SEGACT MSOLEN*MOD
  154. LTAB=ISOLEN(/1)
  155. DO 619 I=1,LTAB
  156. IVA=ISOLEN(I)
  157. IF(IVA.EQ.0)GOTO 619
  158. CALL AJOUN(ICO2,IVA,ILISSE,1)
  159. IF (IONIVE.LT.3) GO TO 619
  160. IF(IIICHA.EQ.1) ISOLEN(I)=IVA
  161. 619 CONTINUE
  162. SEGDES MSOLEN
  163. 620 CONTINUE
  164. SEGDES MSOLUT
  165. 618 CONTINUE
  166. GOTO 599
  167. C ************************** MSTRUC ********************************
  168. 509 CONTINUE
  169. ICO1=KCOLA(12)
  170. DO 621 IEL=M1,M2
  171. MSTRUC=ITLAC(IEL)
  172. IF (MSTRUC.EQ.0) GO TO 621
  173. SEGACT MSTRUC*MOD
  174. DO 622 I=1,LISTRU(/1)
  175. IVA=LISTRU(I)
  176. IF(IVA.EQ.0) GO TO 622
  177. IF(IVA.GT.0) THEN
  178. CALL AJOUN(ICO1,IVA,ILISSE,1)
  179. IF(IIICHA.EQ.1) LISTRU(I)=-IVA
  180. ENDIF
  181. 622 CONTINUE
  182. SEGDES MSTRUC
  183. 621 CONTINUE
  184. GOTO 599
  185. C ******************************* MTABLE **************************
  186. * POUR LES TABLES ON COMMENCE PAR METTRE DANS LA PILE DES REELS
  187. * LES VALEURS REELLES ON ON PREND LEUR INDICE
  188. * CECI NOUS PERMET D'ETRE COMPATIBLE AVEC LES VERSIONS ANTERIEURES
  189. * PV 28 DECEMBRE 1988
  190. 510 CONTINUE
  191. DO 710 IEL=M1,M2
  192.  
  193. MTABLE=ITLAC(IEL)
  194. IF (MTABLE.EQ.0) GO TO 710
  195. SEGACT MTABLE*MOD
  196. L6=MLOTAB
  197. IF (L6.EQ.0) GO TO 713
  198. DO 711 K=1,L6
  199.  
  200. ITYP1=MTABTI(K)
  201. IF (IIICHA.NE.1.AND.ITYP1.EQ.'FLOTTANT') THEN
  202. XVA=RMTABI(K)
  203. CALL QUERAN(IVA,'FLOTTANT',0,XVA,' ',.TRUE.,0)
  204. MTABII(K)=IVA
  205. ENDIF
  206. IVA=MTABII(K)
  207. J=0
  208. CALL TYPFIL (ITYP1,J)
  209. IF(J.LE.0) GO TO 711
  210. ICO2=KCOLA(J)
  211. NUMLIS=1
  212. ilissd=ilissg
  213. IF(J.EQ.24) NUMLIS=6
  214. IF(J.EQ.25) NUMLIS=4
  215. IF(J.EQ.26) NUMLIS=2
  216. IF(J.EQ.27) NUMLIS=5
  217. IF(J.EQ.32) then
  218. NUMLIS=3
  219. ilissd=ilissp
  220. endif
  221. IF(J.EQ.36) NUMLIS=7
  222. IF(J.EQ.45) NUMLIS=5
  223. CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  224. IF(IIICHA.EQ.1) MTABII(K)=IVA
  225. ITYP1=MTABTV(K)
  226. IF (IIICHA.NE.1.AND.ITYP1.EQ.'FLOTTANT') THEN
  227. XVA=RMTABV(K)
  228. CALL QUERAN(IVA,'FLOTTANT',0,XVA,' ',.TRUE.,0)
  229. MTABIV(K)=IVA
  230. ENDIF
  231. IVA=MTABIV(K)
  232. CALL TYPFIL (ITYP1,J)
  233. IF(J.LE.0) GO TO 711
  234. IF (J.EQ.47) GO TO 711
  235. ICO2=KCOLA(J)
  236. NUMLIS=1
  237. ilissd=ilissg
  238. IF(J.EQ.24) NUMLIS=6
  239. IF(J.EQ.25) NUMLIS=4
  240. IF(J.EQ.26) NUMLIS=2
  241. IF(J.EQ.27) NUMLIS=5
  242. IF(J.EQ.32) then
  243. NUMLIS=3
  244. ilissd=ilissp
  245. endif
  246. IF(J.EQ.36) NUMLIS=7
  247. IF(J.EQ.45) NUMLIS=5
  248. CALL AJOUN (ICO2,IVA,ILISSD,NUMLIS)
  249. IF(IIICHA.EQ.1) MTABIV(K)=IVA
  250. 711 CONTINUE
  251. 713 SEGDES MTABLE
  252. 710 CONTINUE
  253. GO TO 599
  254. 715 CONTINUE
  255. MOTERR(1:8)=ITYP1
  256. CALL ERREUR (336)
  257. GO TO 599
  258. C ******************************* *************************
  259. 511 CONTINUE
  260. GO TO 599
  261. C ******************************** MSOSTU **************************
  262. 512 CONTINUE
  263. ICO5=KCOLA(5)
  264. ICO3=KCOLA(3)
  265. DO 630 IEL=M1,M2
  266. MSOSTU=ITLAC(IEL)
  267. IF (MSOSTU.EQ.0) GO TO 630
  268. SEGACT MSOSTU*MOD
  269. IVA=ISRAID
  270. IF (IVA.NE.0)CALL AJOUN(ICO3,IVA,ILISSE,1)
  271. IF(IIICHA.EQ.1)ISRAID=IVA
  272. IVA=ISMASS
  273. IF (IVA.NE.0)CALL AJOUN(ICO3,IVA,ILISSE,1)
  274. IF(IIICHA.EQ.1)ISMASS=IVA
  275. NS=ISCHAM(/1)
  276. IF (NS.EQ.0) GO TO 122
  277. DO 121 I=1,NS
  278. IVA= ISCHAM(I)
  279. IF (IVA.NE.0)CALL AJOUN (ICO5,IVA,ILISSE,1)
  280. IF(IIICHA.EQ.1) ISCHAM(I)=IVA
  281. 121 CONTINUE
  282. 122 SEGDES MSOSTU
  283. 630 CONTINUE
  284. GO TO 599
  285. C ***************************** IMATRI *****************************
  286. 513 CONTINUE
  287. GO TO 599
  288. C ***************************** MJONCT *****************************
  289. 514 CONTINUE
  290. ICO1=KCOLA(1)
  291. ICO12=KCOLA(12)
  292. ICO2=KCOLA(2)
  293. DO 631 IEL=M1,M2
  294. MJONCT=ITLAC(IEL)
  295. IF (MJONCT.EQ.0) GO TO 631
  296. SEGACT MJONCT*MOD
  297. IVA=MJOPOI
  298. IF(MJOTYP.EQ.'CHOC')THEN
  299. IF(IVA.NE.0) CALL AJOUN(ICO2,IVA,ILISSE,1)
  300. ELSE
  301. IF(IVA.NE.0) CALL AJOUN(ICO1,IVA,ILISSE,1)
  302. ENDIF
  303. CCC CALL AJOUN(ICO1,IVA)
  304. IF(IIICHA.EQ.1)MJOPOI=IVA
  305. DO 632 I=1,ISTRJO(/1)
  306. IVA=ISTRJO(I)
  307. IF (IVA.NE.0)CALL AJOUN(ICO12,IVA,ILISSE,1)
  308. IF(IIICHA.EQ.1)ISTRJO(I)=IVA
  309. IVA=IPCHJO(I)
  310. IF (IVA.NE.0)CALL AJOUN(ICO2,IVA,ILISSE,1)
  311. IF(IIICHA.EQ.1)IPCHJO(I)=IVA
  312. IVA=IPOSJO(I)
  313. IF (IVA.NE.0) CALL AJOUN(ICO1,IVA,ILISSE,1)
  314. IF(IIICHA.EQ.1)IPOSJO(I)=IVA
  315. 632 CONTINUE
  316. SEGDES MJONCT
  317. 631 CONTINUE
  318. GO TO 599
  319. C ************************ MATTAC **********************************
  320. 515 CONTINUE
  321. ICO1=KCOLA(1)
  322. ICO3=KCOLA(3)
  323. ICO14=KCOLA(14)
  324. DO 150 IEL=M1,M2
  325. MATTAC =ITLAC(IEL)
  326. IF (MATTAC.EQ.0) GO TO 150
  327. SEGACT MATTAC*MOD
  328. NN=LISATT(/1)
  329. DO 151 I=1,NN
  330. MSOUMA=LISATT(I)
  331. IF (MSOUMA.EQ.0) GO TO 151
  332. SEGACT MSOUMA*MOD
  333. M=IPMATK(/1)
  334. DO 152 J=1,M
  335. IVA=IPMATK(J)
  336. IF (IVA.NE.0)CALL AJOUN (ICO3,IVA,ILISSE,1)
  337. IF(IIICHA.EQ.1) IPMATK(J)=IVA
  338. 152 CONTINUE
  339. N=IATREL(/1)
  340. DO 153 J=1,N
  341. IVA=IATREL(J)
  342. IF (IVA.NE.0)CALL AJOUN (ICO14,IVA,ILISSE,1)
  343. IF(IIICHA.EQ.1) IATREL(J)=IVA
  344. 153 CONTINUE
  345. IF(IGEOCH.EQ.0) GO TO 156
  346. MGEOCH=IGEOCH
  347. SEGACT MGEOCH*MOD
  348. NI=INORCH(/1)
  349. DO 154 J=1,NI
  350. IVA=INORCH(J)
  351. IF (IVA.NE.0)CALL AJOUN (ICO1 ,IVA,ILISSE,1)
  352. IF(IIICHA.EQ.1) INORCH(J)=IVA
  353. 154 CONTINUE
  354. N1=IMAPRO(/1)
  355. DO 155 J=1,N1
  356. IVA=IMAPRO(J)
  357. IF (IVA.NE.0)CALL AJOUN (ICO1 ,IVA,ILISSE,1)
  358. IF(IIICHA.EQ.1) IMAPRO(J)=IVA
  359. 155 CONTINUE
  360. SEGDES MGEOCH
  361. 156 CONTINUE
  362. SEGDES MSOUMA
  363. 151 CONTINUE
  364. SEGDES MATTAC
  365. 150 CONTINUE
  366. GO TO 599
  367. C ************************ MMATRI **********************************
  368. 516 CONTINUE
  369. ICO1=KCOLA(1)
  370. DO 633 IEL=M1,M2
  371. MMATRI=ITLAC(IEL)
  372. IF (MMATRI.EQ.0) GO TO 633
  373. SEGACT MMATRI*MOD
  374. IVA=IGEOMA
  375. CALL AJOUN(ICO1,IVA,ILISSE,1)
  376. IF(IIICHA.EQ.1)IGEOMA=IVA
  377. SEGDES MMATRI
  378. 633 CONTINUE
  379. GOTO 599
  380. C *************************MDEFOR***********************************
  381. 517 CONTINUE
  382. ICO1=KCOLA(1)
  383. ICO2=KCOLA(2)
  384. ICO30=KCOLA(30)
  385. ICO38=KCOLA(38)
  386. ICO39=KCOLA(39)
  387. DO 634 IEL=M1,M2
  388. MDEFOR=ITLAC(IEL)
  389. IF (MDEFOR.EQ.0) GO TO 634
  390. SEGACT MDEFOR*MOD
  391. NDEF=IELDEF(/1)
  392. DO 635 I=1,NDEF
  393. IVA=IELDEF(I)
  394. CALL AJOUN(ICO1,IVA,ILISSE,1)
  395. IF(IIICHA.EQ.1)IELDEF(I)=IVA
  396. IVA=ICHDEF(I)
  397. CALL AJOUN(ICO2,IVA,ILISSE,1)
  398. IF(IIICHA.EQ.1)ICHDEF(I)=IVA
  399. IVA=MTVECT(I)
  400. IF (IVA.NE.0) THEN
  401. CALL AJOUN(ICO30,IVA,ILISSE,1)
  402. IF(IIICHA.EQ.1)MTVECT(I)=IVA
  403. ENDIF
  404. IVA=MDCHP(I)
  405. IF (IVA.NE.0) THEN
  406. CALL AJOUN(ICO2,IVA,ILISSE,1)
  407. IF(IIICHA.EQ.1)MDCHP(I)=IVA
  408. ENDIF
  409. IVA=MDCHEL(I)
  410. IF (IVA.NE.0) THEN
  411. CALL AJOUN(ICO39,IVA,ILISSE,1)
  412. IF(IIICHA.EQ.1)MDCHEL(I)=IVA
  413. ENDIF
  414. IVA=MDMODE(I)
  415. IF (IVA.NE.0) THEN
  416. CALL AJOUN(ICO38,IVA,ILISSE,1)
  417. IF(IIICHA.EQ.1)MDMODE(I)=IVA
  418. ENDIF
  419. 635 CONTINUE
  420. SEGDES MDEFOR
  421. 634 CONTINUE
  422. GOTO 599
  423. C ****************************MLREEL*******************************
  424. 518 CONTINUE
  425. GOTO 599
  426. C ****************************MLENTI******************************
  427. 519 CONTINUE
  428. GOTO 599
  429. C ****************************MCHARG*****************************
  430. 520 CONTINUE
  431. ICO1=KCOLA(2)
  432. ICO2=KCOLA(18)
  433. ICO3=KCOLA(39)
  434. ICO4=KCOLA(10)
  435. ICO5=KCOLA(1)
  436. DO 650 IEL=M1,M2
  437. MCHARG=ITLAC(IEL)
  438. IF (MCHARG.EQ.0) GO TO 650
  439. SEGACT MCHARG
  440. DO 651 I=1,KCHARG(/1)
  441. ICHARG=KCHARG(I)
  442. SEGACT ICHARG*MOD
  443. IF(CHATYP.EQ.'CHPOINT ') THEN
  444. IVA=ICHPO1
  445. IF(IVA.GT.0) THEN
  446. CALL AJOUN(ICO1,IVA,ILISSE,1)
  447. IF(IIICHA.EQ.1) ICHPO1=-IVA
  448. ENDIF
  449. IVA=ICHPO2
  450. IF(IVA.GT.0) THEN
  451. CALL AJOUN(ICO2,IVA,ILISSE,1)
  452. IF(IIICHA.EQ.1) ICHPO2=-IVA
  453. ENDIF
  454. IVA=ICHPO3
  455. IF(IVA.GT.0) THEN
  456. CALL AJOUN(ICO2,IVA,ILISSE,1)
  457. IF(IIICHA.EQ.1) ICHPO3=-IVA
  458. ENDIF
  459. ELSEIF(CHATYP.EQ.'MCHAML ') THEN
  460. IVA=ICHPO1
  461. IF(IVA.GT.0) THEN
  462. CALL AJOUN(ICO3,IVA,ILISSE,1)
  463. IF(IIICHA.EQ.1) ICHPO1=-IVA
  464. ENDIF
  465. IVA=ICHPO2
  466. IF(IVA.GT.0) THEN
  467. CALL AJOUN(ICO2,IVA,ILISSE,1)
  468. IF(IIICHA.EQ.1) ICHPO2=-IVA
  469. ENDIF
  470. IVA=ICHPO3
  471. IF(IVA.GT.0) THEN
  472. CALL AJOUN(ICO2,IVA,ILISSE,1)
  473. IF(IIICHA.EQ.1) ICHPO3=-IVA
  474. ENDIF
  475. ELSEIF(CHATYP.EQ.'TABLE ') THEN
  476. IVA=ICHPO1
  477. IF(IVA.GT.0) THEN
  478. CALL AJOUN(ICO4,IVA,ILISSE,1)
  479. IF(IIICHA.EQ.1) ICHPO1=-IVA
  480. ENDIF
  481. IVA=ICHPO2
  482. IF(IVA.GT.0) THEN
  483. CALL AJOUN(ICO4,IVA,ILISSE,1)
  484. IF(IIICHA.EQ.1) ICHPO2=-IVA
  485. ENDIF
  486. ENDIF
  487. IF(CHAMOB(I).EQ.'TRAN') THEN
  488. IVA=ICHPO4
  489. IF(IVA.GT.0) THEN
  490. CALL AJOUN(ICO5,IVA,ILISSE,1)
  491. IF(IIICHA.EQ.1) ICHPO4=-IVA
  492. ENDIF
  493. IVA=ICHPO6
  494. IF(IVA.GT.0) THEN
  495. CALL AJOUN(ICO2,IVA,ILISSE,1)
  496. IF(IIICHA.EQ.1) ICHPO6=-IVA
  497. ENDIF
  498. IVA=ICHPO7
  499. IF(IVA.GT.0) THEN
  500. CALL AJOUN(ICO2,IVA,ILISSE,1)
  501. IF(IIICHA.EQ.1) ICHPO7=-IVA
  502. ENDIF
  503. ELSEIF(CHAMOB(I).EQ.'ROTA') THEN
  504. IVA=ICHPO4
  505. IF(IVA.GT.0) THEN
  506. CALL AJOUN(ICO5,IVA,ILISSE,1)
  507. IF(IIICHA.EQ.1) ICHPO4=-IVA
  508. ENDIF
  509. IVA=ICHPO5
  510. IF(IVA.GT.0.AND.IDIM.GT.2) THEN
  511. CALL AJOUN(ICO5,IVA,ILISSE,1)
  512. IF(IIICHA.EQ.1) ICHPO5=-IVA
  513. ENDIF
  514. IVA=ICHPO6
  515. IF(IVA.GT.0) THEN
  516. CALL AJOUN(ICO2,IVA,ILISSE,1)
  517. IF(IIICHA.EQ.1) ICHPO6=-IVA
  518. ENDIF
  519. IVA=ICHPO7
  520. IF(IVA.GT.0) THEN
  521. CALL AJOUN(ICO2,IVA,ILISSE,1)
  522. IF(IIICHA.EQ.1) ICHPO7=-IVA
  523. ENDIF
  524. ELSEIF(CHAMOB(I).EQ.'TRAJ') THEN
  525. IVA=ICHPO4
  526. IF(IVA.GT.0) THEN
  527. CALL AJOUN(ICO1,IVA,ILISSE,1)
  528. IF(IIICHA.EQ.1) ICHPO4=-IVA
  529. ENDIF
  530. IVA=ICHPO5
  531. IF(IVA.GT.0) THEN
  532. CALL AJOUN(ICO5,IVA,ILISSE,1)
  533. IF(IIICHA.EQ.1) ICHPO5=-IVA
  534. ENDIF
  535. IVA=ICHPO6
  536. IF(IVA.GT.0) THEN
  537. CALL AJOUN(ICO2,IVA,ILISSE,1)
  538. IF(IIICHA.EQ.1) ICHPO6=-IVA
  539. ENDIF
  540. ENDIF
  541. SEGDES ICHARG
  542. 651 CONTINUE
  543. SEGDES MCHARG
  544. 650 CONTINUE
  545. GOTO 599
  546. C *************************** *****************************
  547. 521 CONTINUE
  548. GOTO 599
  549. C ****************************MEVOLL******************************
  550. 522 CONTINUE
  551. ICOR=KCOLA(18)
  552. ICOM=KCOLA(29)
  553. DO 660 IEL=M1,M2
  554. MEVOLL=ITLAC(IEL)
  555. IF (MEVOLL.EQ.0) GO TO 660
  556. SEGACT MEVOLL
  557. DO 661 I=1,IEVOLL(/1)
  558. KEVOLL=IEVOLL(I)
  559. SEGACT KEVOLL*MOD
  560. IVA=IPROGX
  561. ICO2=ICOR
  562. IF(IONIVE.GE.3) THEN
  563. IF(TYPX.EQ.'LISTMOTS') THEN
  564. ICO2=ICOM
  565. ELSEIF(TYPX.EQ.'LISTREEL')THEN
  566. ICO2=ICOR
  567. ENDIF
  568. ENDIF
  569. IF(IVA.GT.0) THEN
  570. CALL AJOUN(ICO2,IVA,ILISSE,1)
  571. IF(IIICHA.EQ.1) IPROGX=-IVA
  572. ENDIF
  573. IVA=IPROGY
  574. IF(IONIVE.GE.3) THEN
  575. IF(TYPY.EQ.'LISTMOTS') THEN
  576. ICO2=ICOM
  577. ELSEIF(TYPY.EQ.'LISTREEL')THEN
  578. ICO2=ICOR
  579. ENDIF
  580. ENDIF
  581. IF(IVA.GT.0) THEN
  582. CALL AJOUN(ICO2,IVA,ILISSE,1)
  583. IF(IIICHA.EQ.1) IPROGY=-IVA
  584. ENDIF
  585. SEGDES KEVOLL
  586. 661 CONTINUE
  587. SEGDES MEVOLL
  588. 660 CONTINUE
  589. GOTO 599
  590. C **********************SUPERELE************************************
  591. 523 CONTINUE
  592. ICO1=KCOLA(1)
  593. ICO3=KCOLA(3)
  594. ICO2=KCOLA( 2)
  595. ICO16=KCOLA(16)
  596. DO 5230 IEL=M1,M2
  597. MSUPER=ITLAC(IEL)
  598. IF (MSUPER.EQ.0) GO TO 5230
  599. SEGACT MSUPER*MOD
  600. IVA=MRIGTO
  601. CALL AJOUN(ICO3,IVA,ILISSE,1)
  602. IF(IIICHA.EQ.1)MRIGTO=IVA
  603. IVA=MSUPEL
  604. CALL AJOUN(ICO1,IVA,ILISSE,1)
  605. IF(IIICHA.EQ.1)MSUPEL=IVA
  606. IVA=MSURAI
  607. CALL AJOUN(ICO3,IVA,ILISSE,1)
  608. IF(IIICHA.EQ.1)MSURAI=IVA
  609. IVA=MSUMAS
  610. IF(IVA.NE.0) CALL AJOUN(ICO3,IVA,ILISSE,1)
  611. IF(IIICHA.EQ.1)MSUMAS=IVA
  612. IVA=MCROUT
  613. CALL AJOUN(ICO16,IVA,ILISSE,1)
  614. IF(IIICHA.EQ.1)MCROUT=IVA
  615. c NBINMA=MSUPCH(/1)
  616. c DO 5231 I=1,NBINMA
  617. c IVA=MSUPCH(I)
  618. c CALL AJOUN(ICO2,IVA)
  619. c IF(IIICHA.EQ.1)MSUPCH(I)=IVA
  620. c 5231 CONTINUE
  621. SEGDES MSUPER
  622. 5230 CONTINUE
  623. GOTO 599
  624. C **********************LOGIQUE***********************************
  625. 524 CONTINUE
  626. GOTO 599
  627. C **********************FLOTTANT**********************************
  628. 525 CONTINUE
  629. GOTO 599
  630. C ********************** ENTIER **********************************
  631. 526 CONTINUE
  632. GOTO 599
  633. C ********************** MOT ***********************************
  634. 527 CONTINUE
  635. GOTO 599
  636. C ********************** TEXTE ***********************************
  637. 528 CONTINUE
  638. GOTO 599
  639. C ********************** LISTMOTS*********************************
  640. 529 CONTINUE
  641. GOTO 599
  642. C ********************** VECTEUR**********************************
  643. 530 CONTINUE
  644. ICO1=KCOLA(1)
  645. ICO2=KCOLA( 2)
  646. DO 5300 IEL=M1,M2
  647. MVECTE=ITLAC(IEL)
  648. IF (MVECTE.EQ.0) GO TO 5300
  649. SEGACT MVECTE*MOD
  650. NVEC=ICHPO(/1)
  651. DO 5301 I=1,NVEC
  652. * CE POINTEUR N'EST PAS ACTUELLEMENT REMPLI
  653. * IVA=IGEOV(I)
  654. * CALL AJOUN(ICO1,IVA)
  655. * IF(IIICHA.EQ.1)IGEOV(I)=IVA
  656. IVA=ICHPO(I)
  657. CALL AJOUN(ICO2,IVA,ILISSE,1)
  658. IF(IIICHA.EQ.1)ICHPO(I)=IVA
  659. 5301 CONTINUE
  660. SEGDES MVECTE
  661. 5300 CONTINUE
  662. GOTO 599
  663. C ********************** VECTDOUB*********************************
  664. 531 CONTINUE
  665. GOTO 599
  666. C ********************** POINT *********************************
  667. 532 CONTINUE
  668. GOTO 599
  669. C ********************** CONFIG *********************************
  670. 533 CONTINUE
  671. GOTO 599
  672. C *********************** LISTCHPO ******************************
  673. 534 CONTINUE
  674. ICO2=KCOLA(2)
  675. DO 340 IEL=M1,M2
  676. MLCHPO =ITLAC(IEL)
  677. IF (MLCHPO.EQ.0) GO TO 340
  678. SEGACT MLCHPO*MOD
  679. N1=ICHPOI(/1)
  680. DO 341 I=1,N1
  681. IVA=ICHPOI(I)
  682. CALL AJOUN(ICO2,IVA,ILISSE,1)
  683. IF(IIICHA.EQ.1)ICHPOI(I)=IVA
  684. 341 CONTINUE
  685. SEGDES MLCHPO
  686. 340 CONTINUE
  687. GO TO 599
  688. C ************************** BASEM ********************************
  689. 535 CONTINUE
  690. ICO12=KCOLA(12)
  691. ICO8=KCOLA(8 )
  692. ICO15=KCOLA(15)
  693. DO 350 IEL=M1,M2
  694. MBASEM=ITLAC(IEL)
  695. IF (MBASEM.EQ.0) GO TO 350
  696. SEGACT MBASEM
  697. DO 351 I=1,LISBAS(/1)
  698. MSOBAS=LISBAS(I)
  699. SEGACT MSOBAS*MOD
  700. IVA=IBSTRM(1)
  701. IF(IVA.GT.0) THEN
  702. CALL AJOUN(ICO12,IVA,ILISSE,1)
  703. IF(IIICHA.EQ.1) IBSTRM(1)=-IVA
  704. ENDIF
  705. IVA=IBSTRM(2)
  706. IF(IVA.GT.0) THEN
  707. CALL AJOUN(ICO8,IVA,ILISSE,1)
  708. IF(IIICHA.EQ.1) IBSTRM(2)=-IVA
  709. ENDIF
  710. IVA=IBSTRM(3)
  711. IF (IVA.EQ.0) GOTO 352
  712. IF(IVA.GT.0) THEN
  713. CALL AJOUN(ICO8,IVA,ILISSE,1)
  714. IF(IIICHA.EQ.1) IBSTRM(3)=-IVA
  715. ENDIF
  716. 352 CONTINUE
  717. IVA=IBSTRM(4)
  718. IF (IVA.EQ.0) GOTO 353
  719. IF(IVA.GT.0) THEN
  720. CALL AJOUN(ICO15,IVA,ILISSE,1)
  721. IF(IIICHA.EQ.1) IBSTRM(4)=-IVA
  722. ENDIF
  723. 353 CONTINUE
  724. IVA=IBSTRM(5)
  725. IF (IVA.EQ.0) GOTO 354
  726. IF(IVA.GT.0) THEN
  727. CALL AJOUN(ICO8,IVA,ILISSE,1)
  728. IF(IIICHA.EQ.1) IBSTRM(5)=-IVA
  729. ENDIF
  730. 354 CONTINUE
  731. SEGDES MSOBAS
  732. 351 CONTINUE
  733. SEGDES MBASEM
  734. 350 CONTINUE
  735. GOTO 599
  736. C ************************* PROCEDURE ****************************
  737. 536 CONTINUE
  738. * ICO1=KCOLA(27)
  739. * DO 5360 IEL=M1,M2
  740. * IVA = ITLAC(IEL)
  741. * CALL AJOUN(ICO1,IVA)
  742. * IF(IIICHA.EQ.1) ITLAC (IEL) = IVA
  743. * 5360 CONTINUE
  744. C ************************ MMODEL ********************************
  745. 538 CONTINUE
  746. ICO1 = KCOLA( 1)
  747. ICO10 = KCOLA(10)
  748. ICO29 = KCOLA(29)
  749. ICO40 = kcola(40)
  750. DO 5380 IEL=M1,M2
  751. MMODEL = ITLAC(IEL)
  752. IF (MMODEL.EQ.0) GOTO 5380
  753. SEGACT,MMODEL
  754. DO 5385 I=1,KMODEL(/1)
  755. IMODEL = KMODEL(I)
  756. SEGACT,IMODEL*MOD
  757. IVA = IMAMOD
  758. IF(IVA.GT.0) THEN
  759. CALL AJOUN(ICO1,IVA,ILISSE,1)
  760. IF (IIICHA.EQ.1) IMAMOD =-IVA
  761. ENDIF
  762. IVA = IPDPGE
  763. IF(IVA.GT.0) THEN
  764. CALL AJOUN(ICO1,IVA,ILISSE,1)
  765. IF (IIICHA.EQ.1) IPDPGE =-IVA
  766. ENDIF
  767. C cas 'NAVIER_STOKES' : INFMOD(2) contient une table
  768. NFOR=FORMOD(/2)
  769. IF (NFOR.GT.0) THEN
  770. IF ((FORMOD(1).EQ.'NAVIER_STOKES').OR.
  771. * (FORMOD(1).EQ.'DARCY').OR.
  772. * (FORMOD(1).EQ.'EULER')) THEN
  773. MN3=INFMOD(/1)
  774. IF (MN3.GT.1) THEN
  775. IVA=INFMOD(2)
  776. IF(IVA.GT.0) THEN
  777. CALL AJOUN(ICO10,IVA,ILISSE,1)
  778. IF (IIICHA.EQ.1) INFMOD(2) =-IVA
  779. ENDIF
  780. ENDIF
  781. ENDIF
  782. ENDIF
  783. NM3=INFMOD(/1)
  784. DO IOU=3,NM3
  785. IVA=INFMOD(IOU)
  786. IF(IVA.gt.0) then
  787. IF(IOU.EQ.14) THEN
  788. CALL AJOUN(ICO29,IVA,ilisse,1)
  789. ELSE
  790. CALL AJOUN(ICO40,IVA,ilisse,1)
  791. ENDIF
  792. IF(IIICHA.EQ.1) INFMOD(IOU)=-IVA
  793. ENDIF
  794. ENDDO
  795. IF(tymode(/2). ne . 0) then
  796. do 5387 ihy=1,tymode(/2)
  797. ITYP1=tymode(ihy)
  798. IVA=IVAMOD(ihy)
  799. J=0
  800. if( iva.lt.0) go to 5387
  801. CALL TYPFIL (ITYP1,J)
  802. IF(J.LE.0.or.j.eq.32) GO TO 5387
  803. ICO2=KCOLA(J)
  804. NUMLIS=1
  805. ilissd=ilissg
  806. IF(J.EQ.24) NUMLIS=6
  807. IF(J.EQ.25) NUMLIS=4
  808. IF(J.EQ.26) NUMLIS=2
  809. IF(J.EQ.27) NUMLIS=5
  810. IF(J.EQ.32) then
  811. NUMLIS=3
  812. ilissd=ilissp
  813. endif
  814. IF(J.EQ.36) NUMLIS=7
  815. IF(J.EQ.45) NUMLIS=5
  816. CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  817. IF(IIICHA.EQ.1)IVAMOD(ihy) =-IVA
  818. 5387 continue
  819. endif
  820. SEGDES,IMODEL
  821. 5385 CONTINUE
  822. SEGDES,MMODEL
  823. 5380 CONTINUE
  824. GOTO 599
  825. C ************************ MCHAML ********************************
  826. 539 CONTINUE
  827. CALL EXCHAM(ICOLAC,ITLACC,M1,M2,IIICHA)
  828. GOTO 599
  829. C ************************ MINTE ********************************
  830. 540 CONTINUE
  831. GOTO 599
  832. C ************************ NUAGE ********************************
  833. 541 CONTINUE
  834. DO 810 IEL=M1,M2
  835. MNUAGE=ITLAC(IEL)
  836. IF (MNUAGE.EQ.0) GO TO 810
  837. SEGACT MNUAGE
  838. L6=NUAPOI(/1)
  839. IF (L6.EQ.0) GO TO 813
  840. DO 811 K=1,L6
  841. ITYP1=NUATYP(K)
  842. ISIN=NUAPOI(K)
  843. J=0
  844. IF(ITYP1.EQ.'FLOTTANT'.OR.ITYP1.EQ.'ENTIER '.OR.
  845. $ ITYP1.EQ.'MOT '.OR.ITYP1.EQ.'LOGIQUE ') GO TO 811
  846. CALL TYPFIL (ITYP1,J)
  847. IF(J.LE.0) GO TO 811
  848. ICO2=KCOLA(J)
  849. NUMLIS=1
  850. ilissd=ilissg
  851. IF(J.EQ.32) then
  852. NUMLIS=3
  853. ilissd=ilissp
  854. endif
  855. IF(J.EQ.36) NUMLIS=7
  856. IF(J.EQ.45) NUMLIS=5
  857. NUAVIN=ISIN
  858. SEGACT NUAVIN*MOD
  859. DO 816 LL =1,NUAINT(/1)
  860. IVA=NUAINT(LL)
  861. CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  862. IF(IIICHA.EQ.1) NUAINT(LL)=IVA
  863. 816 CONTINUE
  864. SEGDES NUAVIN
  865. 811 CONTINUE
  866. 813 SEGDES MNUAGE
  867. 810 CONTINUE
  868. GO TO 599
  869. C **************************** MATRAK ******************************
  870. 542 CONTINUE
  871. C ICO1=KCOLA(1)
  872. CALL EXAMTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  873. GO TO 599
  874. C **************************** MATRIK ******************************
  875. 543 CONTINUE
  876. C ICO1=KCOLA(1)
  877. CALL EXANTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  878. GO TO 599
  879. C ****************************** METHODE ***************************
  880. 545 CONTINUE
  881. ICO1=KCOLA(27)
  882. DO 5450 IEL=M1,M2
  883. IVA = ITLAC(IEL)
  884. CALL AJOUN(ICO1,IVA,ILISSE,5)
  885. IF(IIICHA.EQ.1) ITLAC (IEL) = IVA
  886. 5450 CONTINUE
  887. GO TO 599
  888. C ****************************** ESCLAVE ***************************
  889. 546 CONTINUE
  890. DO 5460 IEL=M1,M2
  891. mesres=itlac(iel)
  892. segact mesres
  893. nesres=iesres
  894. segact nesres
  895. if (.not.loremp) goto 5460
  896. ityp1=esrety
  897. k=0
  898. call typfil(ityp1,k)
  899. if (k.le.0) goto 5460
  900. if (k.eq.24) goto 5460
  901. if (k.eq.25) goto 5460
  902. if (k.eq.26) goto 5460
  903. if (k.eq.27) goto 5460
  904. ico1=kcola(k)
  905. iva=esreva
  906. NUMLIS=1
  907. ilissd=ilissg
  908. IF(J.EQ.32) then
  909. NUMLIS=3
  910. ilissd=ilissp
  911. endif
  912. IF(k.EQ.36) NUMLIS=7
  913. IF(K.EQ.45) NUMLIS=5
  914. * write (6,*) ' expill esclave renvoie sur ',ityp1,iva
  915. call ajoun(ico1,iva,ilissd,numlis)
  916. segdes nesres
  917. segdes mesres
  918. 5460 continue
  919. C JYY print*, ' passage ESCLAVE dans expil'
  920. GO TO 599
  921. C ***************************** FANTOME ****************************
  922. 547 CONTINUE
  923. GO TO 599
  924. C ***************************** IELVAL *****************************
  925. 548 CONTINUE
  926. GO TO 599
  927.  
  928. 599 CONTINUE
  929. SEGDES ICOLAC
  930. RETURN
  931. END
  932.  
  933.  
  934.  
  935.  
  936.  
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943.  

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