Télécharger expil.eso

Retour à la liste

Numérotation des lignes :

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

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