Télécharger expil.eso

Retour à la liste

Numérotation des lignes :

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

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