Télécharger expil.eso

Retour à la liste

Numérotation des lignes :

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

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