Télécharger expil.eso

Retour à la liste

Numérotation des lignes :

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

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