Télécharger expil.eso

Retour à la liste

Numérotation des lignes :

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

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