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

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