Télécharger lipil.eso

Retour à la liste

Numérotation des lignes :

  1. C LIPIL SOURCE PV 16/11/26 21:16:00 9205
  2. SUBROUTINE LIPIL (ICOLAC,IFIN,IRET,IFORM,LABEL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C BUT : LECTURE DU FICHIER FORMATE OU NON IORES DEFINI PAR:
  7. C OPTIO REST IORES ;
  8. C APPELE PAR : REST
  9. C APPELLE : LFCDIM LFCDIE LFCDI2 NOMNST ENSOLF ENTNOM
  10. C : LIPOIN LIMAIL ERREUR(12)
  11. C ECRIT PAR FARVACQUE -REPRIS PAR LENA
  12. C
  13. C HISTORIQUE : ajout des objets de type MATRAK et MATRIK par
  14. C GOUNAND (15/07/98)
  15. C
  16. C=======================================================================
  17. C TABLEAU KCOLA: VOIR LE SOUS-PROGRAMME TYPFIL
  18. C=======================================================================
  19. -INC CCOPTIO
  20. -INC SMELEME
  21. -INC SMBASEM
  22. -INC SMCOORD
  23. POINTEUR MCOOR1.MCOORD,MCOOR2.MCOORD
  24. -INC SMRIGID
  25. -INC SMELSTR
  26. -INC SMCLSTR
  27. -INC SMDEFOR
  28. -INC SMSTRUC
  29. -INC SMLREEL
  30. -INC SMLENTI
  31. -INC SMLMOTS
  32. -INC SMTEXTE
  33. -INC SMTABLE
  34. -INC SMSUPER
  35. -INC SMVECTD
  36. -INC SMCHARG
  37. -INC SMEVOLL
  38. -INC SMLCHPO
  39. -INC SMINTE
  40. -INC CCGEOME
  41. -INC TMCOLAC
  42. -INC CCFXDR
  43. -INC CCHAMP
  44. C
  45. SEGMENT JPV(MOTS(/2))
  46. C=======================================================================
  47. C ICOLAC : KCOLA : POINTEUR SUR LA PILE ITLACC
  48. C MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  49. C ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  50. C KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  51. C SORTIR
  52. C=======================================================================
  53. SEGMENT/ITBBE1/( ITABE1(NN))
  54. SEGMENT/ITBBE2/( ITABE2(NN))
  55. segment itbbc2
  56. character*4 itabc2(nn)
  57. endsegment
  58. SEGMENT/ITBBM1/( ITABM1(NM))
  59. segment itbbc1
  60. character*4 itabc1(nm)
  61. endsegment
  62. SEGMENT/ITBBM2/( ITABM2(NM2))
  63. segment itbbc3
  64. character*4 itabc3(nm2)
  65. endsegment
  66. SEGMENT/ITBBM3/( ITABM3(NM2))
  67. segment itbbc4
  68. character*4 itabc4(nm2)
  69. endsegment
  70. SEGMENT/ITBBM4/( ITABM4(NM2))
  71. segment itbbc5
  72. character*4 itabc5(nm2)
  73. endsegment
  74. SEGMENT/ITBBR1/( TABR1(L)*D)
  75. SEGMENT/NOMM1/(NOM1(NOBJN1))
  76. SEGMENT NOMM2
  77. CHARACTER*(8) NOM2(NOBJN1)
  78. ENDSEGMENT
  79. SEGMENT ITAMOT
  80. CHARACTER*(NN) ITAMO
  81. INTEGER ICOTA(NNN)
  82. ENDSEGMENT
  83. C
  84. DIMENSION IPVV(2)
  85. DIMENSION ILENA(30)
  86. DIMENSION NOMM(2)
  87. CHARACTER*(8) ITYPE,CTYPE
  88. CHARACTER*72 LABEL
  89. REAL*8 XVA
  90. LOGICAL LOGI
  91. CHARACTER*(72) CHA1T
  92. CHARACTER*(512) CHA1
  93. CHARACTER*(1) CHARI
  94. REAL*4 DENSI4
  95. C--------------------------------------------------------------------
  96. minouv=0
  97. mlnouv=0
  98. mrnouv=0
  99. IQUOI=0
  100. NOMM1=0
  101. NOMM2=0
  102. ITBBM1=0
  103. ITBBM2=0
  104. ITBBM3=0
  105. ITBBM4=0
  106. ITBBE1=0
  107. ITBBE2=0
  108. ITBBR1=0
  109. IRET=0
  110. IRETOU=0
  111. NOBJN1=0
  112. CHA1T=' '
  113. SEGINI NOMM1
  114. SEGINI NOMM2
  115. SEGACT ICOLAC*MOD
  116. NBANC=XCOOR(/1)/(IDIM+1)
  117. mianc=minouv
  118. mlanc=mlnouv
  119. mranc=mrnouv
  120. C ------------------------------------------------------------------
  121. C --- BOUCLE DE LECTURE SUR UN DESCRIPTEUR-------------------------
  122. 1097 CONTINUE
  123. IRETOU=0
  124. IQUOI=0
  125. CALL LFCDES (IORES,IQUOI,IRETOU,IFORM)
  126. IF (IIMPI.EQ.5) WRITE(IOIMP,555) IQUOI,IRETOU
  127. 555 FORMAT(' ENREG DE TYPE ',I6,' CODE RETOUR DE LECTURE =',I2)
  128. IF(IRETOU.NE.0) THEN
  129. IF( IONIVE.GE.10) THEN
  130. IF(LABEL.EQ.' '.AND.CHA1T.NE.' ') THEN
  131. IRETOU=0
  132. GO TO 1001
  133. ELSE
  134. MOTERR(1:24) = LABEL
  135. CALL ERREUR (874)
  136. GO TO 1000
  137. ENDIF
  138. ELSE
  139. MOTERR(1:24) = LABEL
  140. CALL ERREUR (874)
  141. GO TO 1000
  142. ENDIF
  143. ENDIF
  144. C *** FIN DES LECTURES ********SI IQUOI=5
  145. IF(IQUOI.EQ.5) THEN
  146. IF(IONIVE.GE.10) THEN
  147. IF(IFORM.EQ.1) READ (IORES,776) CHA1T
  148. IF(IFORM.EQ.0) READ (IORES) CHA1T
  149. if (iform.eq.2) ios=IXDRSTRING( ixdrr,cha1t(1:72))
  150. 776 FORMAT(A72)
  151. WRITE (IOIMP,778) CHA1T
  152. 778 FORMAT ( 'FIN DE LECTURE DU LABEL : ',/,A72,/)
  153. mianc=minouv
  154. mlanc=mlnouv
  155. mranc=mrnouv
  156. IF(LABEL.NE.' ') THEN
  157. IF(LABEL.EQ.CHA1T ) GO TO 1001
  158. ENDIF
  159. GO TO 1097
  160. ENDIF
  161. ENDIF
  162. GO TO (999 ,5000,4000,444,1001,999 ,4001,4002 ),IQUOI
  163. C --- ERREUR
  164. 999 GO TO 1000
  165. C--------------------------------------------------------------------
  166. C ***** LECTURE DES INFORMATIONS GENERALES A METTRE DANS LES COMMONS
  167. C --- IQUOI=4
  168. 444 CONTINUE
  169. IF(IFORM.EQ.1)READ(IORES,701,END=1000,ERR=1000) NIVEAU,IARR,JDIM
  170. IF(IFORM.EQ.0)READ(IORES,END=1000,ERR=1000) NIVEAU,IARR,JDIM
  171. if (iform.eq.2) then
  172. ios=IXDRINT( ixdrr, niveau )
  173. ios=IXDRINT( ixdrr, iarr )
  174. ios=IXDRINT( ixdrr, jdim )
  175. endif
  176. IONIVE=NIVEAU
  177. 701 FORMAT(7X,I4,14X,I4,10X,I4)
  178. WRITE (IOIMP,33201) NIVEAU
  179. 33201 FORMAT (//,' NIVEAU DU FICHIER',I3)
  180. CCCCC IF (NIVEAU.NE.0) GOTO 1000
  181. IF (IFORM.EQ.1) READ(IORES,702) DENSI4
  182. IF (IFORM.EQ.0) READ(IORES) DENSI4
  183. if (iform.eq.2) ios=IXDRREAL( ixdrr, densi4 )
  184. densit = densi4
  185. 702 FORMAT(8X,E12.5)
  186. WRITE (IOIMP,201) IaRR,JDIM,DENSIT
  187. 201 FORMAT (//,' NIVEAU D''ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',
  188. 1 1PE12.5)
  189. IERMAX=MAX(IERMAX,IaRR)
  190. * IERR=0
  191. CALLGINT2
  192. IF (IDIM.EQ.0) IDIM=JDIM
  193. IF (JDIM.NE.0.AND.JDIM.NE.IDIM) CALL ERREUR(12)
  194. GOTO 1097
  195. C
  196. C **** Noms des composantes primales et duales *****************
  197. C Repris de la lecture des LISTMOTS
  198. C --- IQUOI=8
  199. 4002 CONTINUE
  200. DO I=1,2
  201. ITOTO=2
  202. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  203. IF (IRETOU.NE.0) GO TO 1000
  204. JGN = ILENA(1)
  205. JGM = ILENA(2)
  206. * SEGINI MLMOTS
  207. NN=JGN*JGM
  208. NNN=0
  209. SEGINI ITAMOT
  210. CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  211. IF(IRETOU.NE.0) GOTO 1000
  212. IF (I.EQ.1) THEN
  213. LNOMDD=MIN(JGM,1000)
  214. KNOMDD=MIN(JGN,LEN(NOMDD(1)))
  215. DO IUH = 1,LNOMDD
  216. ideb = (IUH-1)*JGN+1
  217. ifin = ideb+knomdd-1
  218. NOMDD(IUH)= ITAMO(ideb:ifin)
  219. ENDDO
  220. ELSE
  221. LNOMDU=MIN(JGM,1000)
  222. KNOMDU=MIN(JGN,LEN(NOMDU(1)))
  223. DO IUH = 1,LNOMDU
  224. ideb = (IUH-1)*JGN+1
  225. ifin = ideb+knomdu-1
  226. NOMDU(IUH)= ITAMO(ideb:ifin)
  227. ENDDO
  228. ENDIF
  229. SEGSUP ITAMOT
  230. ENDDO
  231.  
  232. GOTO 1097
  233. C
  234. C **** INFORMATIONS GENERALES CASTEM2000 *****************
  235. C --- IQUOI=7
  236. 4001 CONTINUE
  237. CALL LIINFG (IRETOU,IFORM)
  238. IF(IRETOU.NE.0) GOTO 1000
  239. GOTO 1097
  240. C
  241. C ***** LECTURE D'UN TITRE *************************************
  242. C --- IQUOI=3
  243. 4000 CONTINUE
  244. CALL LFCDIM(IORES,18,ILENA,IRETOU,IFORM)
  245. WRITE(TITREE,FMT='(18A4)')(ILENA(IY),IY=1,18)
  246. IF(IRETOU.NE.0) GOTO 1000
  247. GOTO 1097
  248. C
  249. C ***** LECTURE D'UNE PILE *************************************
  250. C --- IQUOI=2
  251. 5000 CONTINUE
  252. IF(IERR.NE.0) RETURN
  253. ITOTO=3
  254. CALL LFCDIP (IORES,ITOTO,ILENA,IRETOU,IFORM)
  255. IF ( IRETOU.NE.0) GO TO 1000
  256. IFILE =ILENA(1)
  257. NOBJN =ILENA(2)
  258. IMAX1 =ILENA(3)
  259. ITYPE=' '
  260. IF(IFILE.NE.0) THEN
  261. CALL TYPFIL(ITYPE,IFILE)
  262. WRITE (IOIMP,805) IMAX1,ITYPE
  263. 805 FORMAT( ' LECTURE DE ',I5 , ' OBJETS ',A8)
  264. IF(IIMPI.NE.0)
  265. * WRITE(IOIMP,803)IFILE,ITYPE,IMAX1,NOBJN
  266. ELSE
  267. ITYPE='POINT '
  268. IF(IIMPI.NE.0) WRITE(IOIMP,804)IMAX1,NOBJN
  269. ENDIF
  270. 803 FORMAT(///' * LA FILE NUMERO',I4,' CONSTITUEE D''OBJETS DE TYPE
  271. 1 ',A8,' CONTIENT',I5,
  272. 1 ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.')
  273. 804 FORMAT(///' * IL Y A ',I6,' NOUVEAUX POINTS, PARMI LESQUELS ',
  274. 1 I6,' SONT NOMMES.')
  275. C --- LECTURE DES NOMS S ILS EXISTENT
  276. CALL ENTNOM(IORES,NOBJN,NOMM1,NOMM2,IRETOU,IFORM)
  277. IF(IRETOU.NE.0) GOTO 1000
  278. C --- LECTURE DE LA PILE - ON EN LIRA IMAX1-------------------------
  279. IF(IFILE.EQ.0) GO TO 5001
  280. C KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
  281. ITLACC=KCOLA(IFILE)
  282. segact itlacc*mod
  283. IRETOU=0
  284. C ---
  285. if(ionive.ge.17) then
  286. if(ifile.eq.27) then
  287. segsup itlacc
  288. segini itlacc
  289. kcolac(ifile)=imax1
  290. kcola(ifile) = itlacc
  291. endif
  292. endif
  293. GO TO (6001,6002,6003,1002,1002,6006,6007,6008,6009,6010,1002,
  294. 1 6012,6013,6014,6015,6016,6017,6018,6019,6020,1002,6022,
  295. 1 6023,6024,6025,6026,6027,6028,6029,6030,6031,6032,6033,
  296. 1 6034,6035,6036,6037,6038,6039,6040,6041,
  297. 1 6042,6043,6010,6045 ),IFILE
  298. 1002 MOTERR(1:8)=ITYPE
  299. CALL ERREUR(336)
  300. IF (ITYPE.EQ.'ESCLAVE') GOTO 1097
  301. GO TO 1000
  302. C *************** POINTS ET COORD**********************************
  303. 5001 CONTINUE
  304. IF(IONIVE.LE.9) THEN
  305. CALL LIPOIN (IMAX1,NOBJN,NOMM1,NOMM2,NBANC,IRETOU,IFORM)
  306. IF (IRETOU.NE.0) GO TO 1000
  307. ENDIF
  308. GOTO 1097
  309. C **************************MELEME**********************************
  310. 6001 CONTINUE
  311. DO 7 IEL=1,IMAX1
  312. IRETOU=0
  313. CALL LIMAIL (MELEME,NBANC,IRETOU,IFORM)
  314. IF (IRETOU.NE.0) GO TO 1000
  315. ITLAC(**)=MELEME
  316. * si on avait avant la restitution un point support de contact il faut l
  317. * le confondre avec celui restitue.
  318. 7 CONTINUE
  319. GOTO 1098
  320. C **************************CHPOINT*********************************
  321. 6002 CONTINUE
  322. CALL LICHPO(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  323. IF (IRETOU.NE.0) GO TO 1000
  324. GOTO 1098
  325. C ***********************MRIGID*************************************
  326. 6003 CONTINUE
  327. NN=0
  328. SEGINI ITBBE1
  329. NM=0
  330. SEGINI ITBBM1,itbbc1
  331. DO 1202 IEL=1,IMAX1
  332. C READ(IORES,8000,END=1000,ERR=1000) NRIGEL,ICHO,NBGEOR,NRIGE,J
  333. ITOTO=5
  334. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  335. IF (IRETOU.NE.0) GO TO 1000
  336. NRIGEL= ILENA(1)
  337. ICHO = ILENA(2)
  338. NBGEOR= ILENA(3)
  339. NRIGE = ILENA(4)
  340. J = ILENA(5)
  341. SEGINI MRIGID
  342. ITLAC(**)=MRIGID
  343. IFORIG=J
  344. C READ(IORES,8001,END=1000,ERR=1000)MTYMAT(1),MTYMAT(2)
  345. ITOTO=2
  346. CCC CALL LFCDIM (IORES,ITOTO,MTYMAT,IRETOU,IFORM)
  347. if (iform.ne.2) then
  348. CALL LFCDIM (IORES,ITOTO,IPVV,IRETOU,IFORM)
  349. IF (IRETOU.NE.0) GO TO 1000
  350. WRITE(MTYMAT,FMT='(2A4)') IPVV(1),IPVV(2)
  351. else
  352. ios=IXDRSTRING( ixdrr, mtymat(1:8))
  353. if (ios.lt.0) goto 1000
  354. endif
  355. ICHOLE=ICHO
  356. NN=NRIGE*NRIGEL+NBGEOR
  357. IF(IONIVE.GE.5) NN=NN + NRIGEL
  358. SEGADJ ITBBE1
  359. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  360. IF (IRETOU.NE.0) GO TO 1000
  361. NNN=0
  362. DO 1203 IR=1,NRIGEL
  363. II=NRIGE*(IR-1)
  364. DO 1204 NR=1,NRIGE
  365. IRR=II+NR
  366. IRIGEL(NR,IR)=ITABE1(IRR)
  367. 1204 CONTINUE
  368. NLIGRP=ITABE1(II+3)
  369. NLIGRD=NLIGRP
  370. IF(IONIVE.GE.5) THEN
  371. NLIGRD=ITABE1(IR+ NRIGE*NRIGEL+NBGEOR)
  372. ENDIF
  373. NNN=NNN+NLIGRP + NLIGRD
  374. SEGINI DESCR
  375. IRIGEL(3,IR)=DESCR
  376. if(ionive.ge.18) then
  377. nelrig=ITABE1(II+4)
  378. segini xmatri
  379. irigel(4,ir)=xmatri
  380. endif
  381. 1203 CONTINUE
  382. IF(NBGEOR.EQ.0) GOTO 1207
  383. SEGINI IMGEOD
  384. DO 1206 I=1,NBGEOR
  385. IMGEOR(I)=ITABE1(NRIGE*NRIGEL+I)
  386. 1206 CONTINUE
  387. SEGDES IMGEOD
  388. IMGEO1=IMGEOD
  389. 1207 NN=NNN
  390. IF(IONIVE.LT.5) NN=NN/2
  391. SEGADJ ITBBE1
  392. NM=NNN
  393. SEGADJ ITBBM1,itbbc1
  394. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  395. IF(IRETOU.NE.0) GOTO 1000
  396. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  397. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  398. IF(IRETOU.NE.0) GOTO 1000
  399. J=0
  400. DO 1208 IR=1,NRIGEL
  401. DESCR=IRIGEL(3,IR)
  402. SEGACT DESCR*MOD
  403. NLIGRP=NOELEP(/1)
  404. IF(IONIVE.GE.5) THEN
  405. DO 1205 I=1,NLIGRP
  406. J=J+1
  407. NOELEP(I)=ITABE1(J)
  408. if (iform.ne.2) WRITE(LISINC(I),FMT='(A4)')ITABM1(J)
  409. if (iform.eq.2) lisinc(i)=itabc1(j)
  410. 1205 CONTINUE
  411. NLIGRD=NOELED(/1)
  412. DO 1209 I=1,NLIGRD
  413. J=J+1
  414. NOELED(I)=ITABE1(J)
  415. if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(J)
  416. if (iform.eq.2) lisdua(i)=itabc1(j)
  417. 1209 CONTINUE
  418. ELSE
  419. DO 1215 I=1,NLIGRP
  420. J=J+1
  421. NOELEP(I)=ITABE1(J)
  422. NOELED(I)=ITABE1(J)
  423. if (iform.ne.2) then
  424. WRITE(LISINC(I),FMT='(A4)')ITABM1(2*J-1)
  425. else
  426. lisinc(i)=itabc1(2*j-1)
  427. endif
  428. if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(2*J)
  429. if (iform.eq.2) lisdua(i)=itabc1(2*j)
  430. 1215 CONTINUE
  431. ENDIF
  432. SEGDES DESCR
  433. 1208 CONTINUE
  434. CALL LFCDI2(IORES,NRIGEL,COERIG,IRETOU,IFORM)
  435. if(ionive.ge.18) then
  436. do ir=1,nrigel
  437. xmatri=irigel(4,ir)
  438. lval=re(/1)*re(/2)*re(/3)
  439. call lfcdi2(iores,lval,re,iretou,iform)
  440. segdes xmatri
  441. enddo
  442. endif
  443. SEGDES MRIGID
  444. IF(IRETOU.NE.0) GOTO 1000
  445. 1202 CONTINUE
  446. SEGSUP ITBBM1,itbbc1,ITBBE1
  447. GOTO 1098
  448. C *************************** *******************************
  449. 6004 CONTINUE
  450. GOTO 1098
  451. C *********************** *********************************
  452. 6005 CONTINUE
  453. GOTO 1098
  454. C ********************************BLOQ STRUC
  455. 6006 CONTINUE
  456. DO 60 IEL=1,IMAX1
  457. ITOTO=1
  458. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  459. IF(IRETOU.NE.0) GO TO 1000
  460. N=ILENA(1)
  461. SEGINI MCLSTR
  462. ITLAC(**)= MCLSTR
  463. CALL LFCDIE (IORES,N ,ISOSTR,IRETOU,IFORM)
  464. IF(IRETOU.NE.0) GO TO 1000
  465. CALL LFCDIE (IORES,N ,IRIGCL,IRETOU,IFORM)
  466. IF(IRETOU.NE.0) GO TO 1000
  467. SEGDES MCLSTR
  468. 60 CONTINUE
  469. GO TO 1098
  470. C ********************************ELEM STRUC
  471. 6007 CONTINUE
  472. DO 70 IEL=1,IMAX1
  473. ITOTO=1
  474. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  475. IF(IRETOU.NE.0) GO TO 1000
  476. N=ILENA(1)
  477. SEGINI MELSTR
  478. ITLAC(**) =MELSTR
  479. CALL LFCDIE (IORES,N ,ISOSTU,IRETOU,IFORM)
  480. IF(IRETOU.NE.0) GO TO 1000
  481. CALL LFCDIE (IORES,N ,IMELEM,IRETOU,IFORM)
  482. IF(IRETOU.NE.0) GO TO 1000
  483. SEGDES MELSTR
  484. 70 CONTINUE
  485. GO TO 1098
  486. C ****************************MSOLUT********************************
  487. 6008 CONTINUE
  488. IMAX2=IMAX1
  489. DO 1800 IEL=1,IMAX1
  490. IRETOU=0
  491. IF (NIVEAU.LE.2) CALL ENSOLF(ICOLAC,IRET,IFORM)
  492. IF (NIVEAU.LE.2) MSOLUT=IRET
  493. IF (NIVEAU.GE.3) CALL LISOLU(MSOLUT,IRETOU,IFORM)
  494. IF (IRETOU.NE.0) GO TO 1000
  495. IRET=MSOLUT
  496. IF(IRET.GE.0) THEN
  497. ITLAC(**)=IRET
  498. ELSE
  499. IF(IRET.LT.0) THEN
  500. ITLAC(**)=-IRET
  501. IMAX2=IEL
  502. ELSE
  503. IMAX2=IEL-1
  504. ENDIF
  505. GOTO 1801
  506. ENDIF
  507. 1800 CONTINUE
  508. 1801 CONTINUE
  509. IMAX1=IMAX2
  510. GOTO 1098
  511. C ***************************MSTRUC********************************
  512. 6009 CONTINUE
  513. DO 1901 IEL=1,IMAX1
  514. C READ(IORES,8000,END=1000,ERR=1000) N
  515. ITOTO=1
  516. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  517. IF (IRETOU.NE.0) GO TO 1000
  518. N = ILENA(1)
  519. SEGINI MSTRUC
  520. ITLAC(**)=MSTRUC
  521. CALL LFCDIE(IORES,N,LISTRU,IRETOU,IFORM)
  522. IF(IRETOU.NE.0) GOTO 1000
  523. SEGDES MSTRUC
  524. 1901 CONTINUE
  525. GOTO 1098
  526. C ******************************* MTABLE **************************
  527. 6010 CONTINUE
  528. NN=0
  529. SEGINI ITBBE1
  530. ITOTO=1
  531. DO 710 IEL=1,IMAX1
  532. MTABLE=0
  533. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  534. * write (6,*) ' lipil table ',ilena(1)
  535. IF (IRETOU.NE.0) GO TO 1000
  536. NN=ILENA(1)
  537. CCC IF (NN.EQ.0) GO TO 109
  538. M=NN/4
  539. SEGINI MTABLE
  540. MLOTAB=M
  541. IF (NN.EQ.0) GO TO 713
  542. SEGADJ ITBBE1
  543. CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
  544. * write (6,*) ' lipil table ',(itabe1(ii),ii=1,nn)
  545. IF(IRETOU.NE.0) GO TO 1000
  546. KK=0
  547. DO 711 K=1,NN,4
  548. KK=KK+1
  549. J=ITABE1(K)
  550. IVA=ITABE1(K+1)
  551. CTYPE=' '
  552. CALL TYPFIL (CTYPE,J)
  553. if (ctype.eq.'ENTIER') then
  554. * write (6,*) ' lipil indice table ',ctype,iva,mianc
  555. iva=iva+mianc
  556. endif
  557. if (ctype.eq.'FLOTTANT') then
  558. * write (6,*) ' lipil indice table ',ctype,iva,mranc
  559. iva=iva+mranc
  560. endif
  561. if (ctype.eq.'LOGIQUE') then
  562. iva=iva+mlanc
  563. endif
  564. MTABII(KK)=IVA
  565. MTABTI(KK)=CTYPE
  566. J=ITABE1(K+2)
  567. IVA=ITABE1(K+3)
  568. CTYPE=' '
  569. CALL TYPFIL (CTYPE,J)
  570. if (ctype.eq.'ENTIER') then
  571. * write (6,*) ' lipil valeur table ',ctype,iva,mianc
  572. iva=iva+mianc
  573. endif
  574. if (ctype.eq.'FLOTTANT') then
  575. * write (6,*) ' lipil indice table ',ctype,iva,mranc
  576. iva=iva+mranc
  577. endif
  578. if (ctype.eq.'LOGIQUE') then
  579. iva=iva+mlanc
  580. endif
  581. ** en attendant de savoir lire un esclave
  582. IF (CTYPE.EQ.'ESCLAVE') CTYPE='ANNULE'
  583. MTABIV(KK)=IVA
  584. MTABTV(KK)=CTYPE
  585. 711 CONTINUE
  586. 713 SEGDES MTABLE
  587. 109 ITLAC(**)=MTABLE
  588. 710 CONTINUE
  589. SEGSUP ITBBE1
  590. GOTO 1098
  591. C ***************************** *****************************
  592. 6011 CONTINUE
  593. GOTO 1098
  594. C **********************&**MSOSTU*******************************
  595. 6012 CONTINUE
  596. NN=0
  597. SEGINI ITBBE1
  598. DO 2201 IEL=1,IMAX1
  599. ITOTO=1
  600. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  601. IF (IRETOU.NE.0) GO TO 1000
  602. NS = ILENA(1)
  603. SEGINI MSOSTU
  604. ITLAC (**)=MSOSTU
  605. C READ(IORES,8000,END=1000,ERR=1000)ITYSOU,ISRAID,ISMASS
  606. ITOTO=3+NS
  607. NN=ITOTO
  608. SEGADJ ITBBE1
  609. CALL LFCDIE (IORES,ITOTO,ITABE1(1),IRETOU,IFORM)
  610. IF (IRETOU.NE.0) GO TO 1000
  611. ITYSOU= ITABE1(1)
  612. ISRAID= ITABE1(2)
  613. ISMASS= ITABE1(3)
  614. IF (NS.EQ.0) GO TO 120
  615. DO 12 I=1,NS
  616. ISCHAM(I)= ITABE1(I+3)
  617. 12 CONTINUE
  618. 120 SEGDES MSOSTU
  619. 2201 CONTINUE
  620. SEGSUP ITBBE1
  621. GOTO 1098
  622. C ***************************** IMATRI *****************************
  623. 6013 CONTINUE
  624. NN=0
  625. SEGINI ITBBE1
  626. DO 2300 IEL=1,IMAX1
  627. C READ(IORES,8000,END=1000,ERR=1000)NELRIG
  628. ITOTO=1
  629. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  630. IF (IRETOU.NE.0) GO TO 1000
  631. nelrig=0
  632. nligrp=0
  633. nligrd=0
  634. NELRIG= ILENA(1)
  635. NN=2
  636. SEGADJ ITBBE1
  637. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  638. IF(IRETOU.NE.0) GOTO 1000
  639. NLIGRD=ITABE1(1)
  640. NLIGRP=ITABE1(2)
  641. LVAL=NLIGRP*NLIGRD
  642. segini xmatri
  643. * write(6,*) ' nligrd nligrp nelrig',nligrd,nligrp,nelrig
  644. ITLAC(**)=xMATRI
  645. DO 2301 J=1,NELRIG
  646. if (lval.ne.0)
  647. > CALL LFCDI2(IORES,LVAL,RE(1,1,j),IRETOU,IFORM)
  648. IF(IRETOU.NE.0) GOTO 1000
  649. 2301 CONTINUE
  650. SEGDES xMATRI
  651. 2300 CONTINUE
  652. SEGSUP ITBBE1
  653. GOTO 1098
  654. C ***************************** MJONCT *****************************
  655. 6014 CONTINUE
  656. CALL LIJONC (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  657. IF (IRETOU.NE.0) GO TO 1000
  658. GOTO 1098
  659. C ***************************** MATTAC *****************************
  660. 6015 CONTINUE
  661. CALL LIATTA (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  662. IF (IRETOU.NE.0) GO TO 1000
  663. GOTO 1098
  664. C ***************************** MMATRI *****************************
  665. 6016 CONTINUE
  666. CALL LIMMAT (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  667. IF (IRETOU.NE.0) GO TO 1000
  668. GOTO 1098
  669. C *************************MDEFOR*******************************
  670. 6017 CONTINUE
  671. NN=0
  672. SEGINI ITBBE1
  673. DO 2700 IEL=1,IMAX1
  674. C READ(IORES,8000,END=1000,ERR=1000) NDEF
  675. ITOTO=1
  676. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  677. IF (IRETOU.NE.0) GO TO 1000
  678. NDEF = ILENA(1)
  679. SEGINI MDEFOR
  680. ITLAC(**)=MDEFOR
  681. CALL LFCDI2(IORES,NDEF,AMPL,IRETOU,IFORM)
  682. IF(IRETOU.NE.0) GOTO 1000
  683. C READ(IORES,8000,END=1000,ERR=1000)(IELDEF(I),I=1,NDEF),(ICHDEF(I),
  684. C 1 I=1,NDEF), (JCOUL(I),I=1,NDEF)
  685. NN=7*NDEF
  686. SEGADJ ITBBE1
  687. CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
  688. IF (IRETOU.NE.0) GO TO 1000
  689. CALL JDANSI ( IELDEF(1),ITABE1(1),NDEF)
  690. CALL JDANSI ( ICHDEF(1),ITABE1(NDEF +1),NDEF)
  691. CALL JDANSI ( JCOUL(1),ITABE1(2*NDEF+1),NDEF)
  692. CALL JDANSI ( MTVECT(1),ITABE1(3*NDEF+1),NDEF)
  693. CALL JDANSI ( MDCHP(1),ITABE1(4*NDEF+1),NDEF)
  694. CALL JDANSI ( MDCHEL(1),ITABE1(5*NDEF+1),NDEF)
  695. CALL JDANSI ( MDMODE(1),ITABE1(6*NDEF+1),NDEF)
  696. SEGDES MDEFOR
  697. 2700 CONTINUE
  698. SEGSUP ITBBE1
  699. GOTO 1098
  700. C ******************************MLREEL**************************
  701. 6018 CONTINUE
  702. DO 2800 IEL=1,IMAX1
  703. C READ(IORES,8000,END=1000,ERR=1000)N
  704. ITOTO=1
  705. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  706. IF (IRETOU.NE.0) GO TO 1000
  707. N = ILENA(1)
  708. JG=N
  709. SEGINI MLREEL
  710. CALL LFCDI2(IORES,N,PROG,IRETOU,IFORM)
  711. SEGDES MLREEL
  712. IF(IRETOU.NE.0) GOTO 1000
  713. ITLAC(**)=MLREEL
  714. 2800 CONTINUE
  715. GOTO 1098
  716. C ******************************MLENTI****************************
  717. 6019 CONTINUE
  718. DO 2900 IEL=1,IMAX1
  719. ITOTO=1
  720. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  721. IF (IRETOU.NE.0) GO TO 1000
  722. N = ILENA(1)
  723. JG=N
  724. SEGINI MLENTI
  725. CALL LFCDEE(IORES,N,LECT,IRETOU,IFORM)
  726. SEGDES MLENTI
  727. IF(IRETOU.NE.0) GOTO 1000
  728. ITLAC(**)=MLENTI
  729. 2900 CONTINUE
  730. GOTO 1098
  731. C ****************************MCHARG******************************
  732. 6020 CONTINUE
  733. NN=0
  734. NM=0
  735. NM2=0
  736. SEGINI ITBBM1,itbbc1
  737. SEGINI ITBBM2,itbbc3
  738. SEGINI ITBBM3,itbbc4
  739. SEGINI ITBBM4,itbbc5
  740. SEGINI ITBBE1
  741. SEGINI ITBBE2,itbbc2
  742. DO 3000 IEL=1,IMAX1
  743. C READ(IORES,8000,END=1000,ERR=1000)N
  744. IF(IONIVE.LE.6) THEN
  745. ITOTO=1
  746. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  747. IF (IRETOU.NE.0) GO TO 1000
  748. N = ILENA(1)
  749. SEGINI MCHARG
  750. NM=2*N
  751. SEGADJ ITBBM1,itbbc1
  752. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  753. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  754. IF(IRETOU.NE.0) GOTO 1000
  755. NN=3*N
  756. SEGADJ ITBBE1
  757. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  758. IF(IRETOU.NE.0) GOTO 1000
  759. DO 3001 I=1,N
  760. c WRITE (CHANOM(I),FMT='(I4)') I
  761. CHANOM(I)=' '
  762. SEGINI ICHARG
  763. KCHARG(I)=ICHARG
  764. I2=2*I
  765. I3=3*I
  766. if (iform.ne.2) then
  767. WRITE (CHANAT(I),FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  768. else
  769. chanat(i)(1:4)=itabc1(i2-1)
  770. chanat(i)(5:8)=itabc1(i2)
  771. endif
  772. CHATYP='CHPOINT '
  773. ICHPO1=ITABE1(I3-2)
  774. ICHPO2=ITABE1(I3-1)
  775. ICHPO3=ITABE1(I3)
  776. SEGDES ICHARG
  777. 3001 CONTINUE
  778. ELSE IF (IONIVE.GE.7.AND.IONIVE.LE.10) THEN
  779. ITOTO=1
  780. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  781. IF (IRETOU.NE.0) GO TO 1000
  782. N = ILENA(1)
  783. SEGINI MCHARG
  784. NN=2*N
  785. SEGADJ ITBBE2,itbbc2
  786. if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
  787. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
  788. IF(IRETOU.NE.0) GOTO 1000
  789. NM2=N
  790. SEGADJ ITBBM2,itbbc3
  791. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  792. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  793. IF(IRETOU.NE.0) GOTO 1000
  794. NM=2*N
  795. SEGADJ ITBBM1,itbbc1
  796. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  797. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  798. IF(IRETOU.NE.0) GOTO 1000
  799. NN=3*N
  800. SEGADJ ITBBE1
  801. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  802. IF(IRETOU.NE.0) GOTO 1000
  803. DO 3002 I=1,N
  804. SEGINI ICHARG
  805. KCHARG(I)=ICHARG
  806. I2=2*I
  807. I3=3*I
  808. if (iform.ne.2) then
  809. WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  810. WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
  811. WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
  812. else
  813. chatyp(1:4)=itabc1(i2-1)
  814. chatyp(5:8)=itabc1(i2)
  815. chanat(i)(1:4)=itabc2(i2-1)
  816. chanat(i)(5:8)=itabc2(i2)
  817. chanom(i)=itabc3(i)
  818. endif
  819. c initialise par defaut
  820. CHAMOB(I) = 'STAT'
  821. CHALIE(I) = 'LIE '
  822. c..
  823. ICHPO1=ITABE1(I3-2)
  824. ICHPO2=ITABE1(I3-1)
  825. ICHPO3=ITABE1(I3)
  826. SEGDES ICHARG
  827. 3002 CONTINUE
  828. ELSE
  829. ITOTO=1
  830. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  831. IF (IRETOU.NE.0) GO TO 1000
  832. N = ILENA(1)
  833. SEGINI MCHARG
  834. NN=2*N
  835. SEGADJ ITBBE2,itbbc2
  836. if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
  837. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
  838. IF(IRETOU.NE.0) GOTO 1000
  839. NM2=N
  840. SEGADJ ITBBM2,itbbc3
  841. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  842. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  843. IF(IRETOU.NE.0) GOTO 1000
  844. SEGADJ ITBBM3,itbbc4
  845. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM3,IRETOU,IFORM)
  846. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc4(1)(1:nm2*4))
  847. IF(IRETOU.NE.0) GOTO 1000
  848. SEGADJ ITBBM4,itbbc5
  849. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM4,IRETOU,IFORM)
  850. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc5(1)(1:nm2*4))
  851. IF(IRETOU.NE.0) GOTO 1000
  852. NM=2*N
  853. SEGADJ ITBBM1,itbbc1
  854. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  855. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  856. IF(IRETOU.NE.0) GOTO 1000
  857. NN=7*N
  858. SEGADJ ITBBE1
  859. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  860. IF(IRETOU.NE.0) GOTO 1000
  861. DO 3003 I=1,N
  862. SEGINI ICHARG
  863. KCHARG(I)=ICHARG
  864. I2=2*I
  865. I3=7*I
  866. if (iform.ne.2) then
  867. WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  868. WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
  869. WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
  870. WRITE (CHAMOB(I),FMT='(1A4)') ITABM3(I)
  871. WRITE (CHALIE(I),FMT='(1A4)') ITABM4(I)
  872. else
  873. chatyp(1:4)=itabc1(i2-1)
  874. chatyp(5:8)=itabc1(i2)
  875. chanat(i)(1:4)=itabc2(i2-1)
  876. chanat(i)(5:8)=itabc2(i2)
  877. chanom(i)=itabc3(i)
  878. chamob(i)=itabc4(i)
  879. chalie(i)=itabc5(i)
  880. endif
  881. ICHPO1=ITABE1(I3-6)
  882. ICHPO2=ITABE1(I3-5)
  883. ICHPO3=ITABE1(I3-4)
  884. ICHPO4=ITABE1(I3-3)
  885. ICHPO5=ITABE1(I3-2)
  886. ICHPO6=ITABE1(I3-1)
  887. ICHPO7=ITABE1(I3)
  888. SEGDES ICHARG
  889. 3003 CONTINUE
  890. ENDIF
  891. SEGDES MCHARG
  892. ITLAC(**)=MCHARG
  893. 3000 CONTINUE
  894. SEGSUP ITBBM1,itbbc1,ITBBE1,ITBBM2,itbbc3,ITBBM3,itbbc4,
  895. > ITBBM4,itbbc5,ITBBE2,itbbc2
  896. GOTO 1098
  897. C **************************** **************************
  898. 6021 CONTINUE
  899. GOTO 1098
  900. C *****************************MEVOLL***************************
  901. 6022 CONTINUE
  902. NN=0
  903. NM=0
  904. NM2=20
  905. SEGINI ITBBM2,itbbc3
  906. SEGINI ITBBE1,ITBBM1,itbbc1
  907. LDECA=7
  908. IF(NIVEAU.GE.3) LDECA=11
  909. LDECA2=18
  910. DO 3200 IEL=1,IMAX1
  911. ITOTO=1
  912. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  913. IF (IRETOU.NE.0) GO TO 1000
  914. N = ILENA(1)
  915. NM2=20
  916. SEGADJ ITBBM2,itbbc3
  917. SEGINI MEVOLL
  918. if (iform.ne.2) then
  919. CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  920. IF(IRETOU.NE.0) GOTO 1000
  921. WRITE (ITYEVO,FMT='(2A4)') ITABM2(1),ITABM2(2)
  922. WRITE(IEVTEX,FMT='(18A4)') (ITABM2(I+2),I=1,18)
  923. else
  924. ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  925. * write (6,*) ' evol itabc3 ',itabc3(1),itabc3(2)
  926. ityevo(1:4)=itabc3(1)
  927. ityevo(5:8)=itabc3(2)
  928. do jpv=1,18
  929. ievtex(1+4*(jpv-1):4*jpv)=itabc3(jpv+2)
  930. enddo
  931. endif
  932. NN=3*N
  933. SEGADJ ITBBE1
  934. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  935. IF(IRETOU.NE.0) GOTO 1000
  936. NM=LDECA*N
  937. SEGADJ ITBBM1,itbbc1
  938. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  939. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  940. IF(IRETOU.NE.0) GOTO 1000
  941. IF (NIVEAU.LT.3) GO TO 221
  942. NM2=LDECA2*N
  943. SEGADJ ITBBM2,itbbc3
  944. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  945. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  946. IF(IRETOU.NE.0) GOTO 1000
  947. 221 CONTINUE
  948. DO 3201 IN=1,N
  949. SEGINI KEVOLL
  950. IEVOLL(IN)=KEVOLL
  951. I4=3*IN
  952. IPROGX=ITABE1(I4-2)
  953. IPROGY=ITABE1(I4-1)
  954. NUMEVX=ITABE1(I4)
  955. I7=LDECA*(IN-1)
  956. if (iform.ne.2) then
  957. WRITE(NOMEVX,FMT='(3A4)')(ITABM1(I7+I),I=1,3)
  958. WRITE(NOMEVY,FMT='(3A4)')(ITABM1(I7+I+3),I=1,3)
  959. WRITE (NUMEVY,FMT='(A4)') ITABM1(I7+7)
  960. IF(NIVEAU.GE.3) THEN
  961. I8=LDECA2*(IN-1)
  962. WRITE(TYPX,FMT='(2A4)')(ITABM1(I7+7+I),I=1,2)
  963. WRITE(TYPY,FMT='(2A4)')(ITABM1(I7+9+I),I=1,2)
  964. WRITE(KEVTEX,FMT='(18A4)') (ITABM2(I8+JPV),JPV=1,18)
  965. ENDIF
  966. else
  967. * write (6,*) ' evol itabc1 ',itabc1(i7+1),itabc1(i7+2)
  968. * write (6,*) ' evol itabc1 ',itabc1(i7+3+1),itabc1(i7+3+2)
  969. nomevx(1:4)=itabc1(i7+1)
  970. nomevx(5:8)=itabc1(i7+2)
  971. nomevx(9:12)=itabc1(i7+3)
  972. nomevy(1:4)=itabc1(i7+3+1)
  973. nomevy(5:8)=itabc1(i7+3+2)
  974. nomevy(9:12)=itabc1(i7+3+3)
  975. numevy=itabc1(i7+7)
  976. if (niveau.ge.3) then
  977. I8=LDECA2*(IN-1)
  978. typx(1:4)=itabc1(i7+7+1)
  979. typx(5:8)=itabc1(i7+7+2)
  980. typy(1:4)=itabc1(i7+9+1)
  981. typy(5:8)=itabc1(i7+9+2)
  982. do jpv=1,18
  983. kevtex(1+(jpv-1)*4:4*jpv)=itabc3(i8+jpv)
  984. enddo
  985. endif
  986. endif
  987. 3202 CONTINUE
  988. SEGDES KEVOLL
  989. 3201 CONTINUE
  990. SEGDES MEVOLL
  991. ITLAC(**)=MEVOLL
  992. 3200 CONTINUE
  993. SEGSUP ITBBE1,ITBBM1,itbbc1
  994. SEGSUP ITBBM2,itbbc3
  995. GOTO 1098
  996. C
  997. C **********************SUPERELE************************************
  998. 6023 CONTINUE
  999. ITOTO=1
  1000. DO 230 IEL=1,IMAX1
  1001. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1002. IF (IRETOU.NE.0) GO TO 1000
  1003. NTOTO=ILENA(1)
  1004. SEGINI MSUPER
  1005. ITLAC(**)=MSUPER
  1006. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  1007. IF (IRETOU.NE.0) GO TO 1023
  1008. MRIGTO=ILENA(1)
  1009. MSUPEL=ILENA(2)
  1010. MSURAI=ILENA(3)
  1011. MBLOQU=ILENA(4)
  1012. MSUMAS=ILENA(5)
  1013. MCROUT=ILENA(6)
  1014. SEGDES MSUPER
  1015. 230 CONTINUE
  1016. GOTO 1098
  1017. 1023 CONTINUE
  1018. SEGDES MSUPER
  1019. GO TO 1000
  1020. C ************************* LOGIQUE ***************************
  1021. 6024 CONTINUE
  1022. ITOTO=1
  1023. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1024. IF (IRETOU.NE.0) GO TO 1000
  1025. N = ILENA(1)
  1026. M=ITLAC(/1)
  1027. do i=m+1,m+n
  1028. itlac(**)=0
  1029. enddo
  1030. CALL LFCDIE (IORES,N,ITLAC(M+1),IRETOU,IFORM)
  1031. IF(IRETOU.NE.0) GOTO 1000
  1032. DO 242 I=m+1,m+n
  1033. ITOTO=ITLAC(I)
  1034. LOGI=.FALSE.
  1035. IF(ITOTO.EQ.1)LOGI=.TRUE.
  1036. CALL QUERAN (IRAT,'LOGIQUE ',IVB,XVA,CTYPE,LOGI,IOB)
  1037. ITLAC(i) =IRAT
  1038. 242 CONTINUE
  1039. mlnouv=itlac(/1)
  1040. GO TO 1098
  1041. C ******************************FLOTTANT**********************
  1042. 6025 CONTINUE
  1043. ITOTO=1
  1044. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1045. IF (IRETOU.NE.0) GO TO 1000
  1046. N = ILENA(1)
  1047. M=ITLAC(/1)
  1048. L=N
  1049. SEGINI ITBBR1
  1050. CALL LFCDI2(IORES,N,TABR1,IRETOU,IFORM)
  1051. IF(IRETOU.NE.0) GO TO 1000
  1052. DO 250 I=1,N
  1053. XVA=TABR1(I)
  1054. CALL QUERAN(IRAT,'FLOTTANT',IVB,XVA,CTYPE,LOGI,IOB)
  1055. ITLAC(**)=IRAT
  1056. 250 CONTINUE
  1057. SEGSUP ITBBR1
  1058. ITBBR1=0
  1059. mrnouv=itlac(/1)
  1060. GO TO 1098
  1061. C **************************** ENTIER***************************
  1062. 6026 CONTINUE
  1063. ITOTO=1
  1064. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1065. IF (IRETOU.NE.0) GO TO 1000
  1066. N = ILENA(1)
  1067. M=ITLAC(/1)
  1068. L=N
  1069. NN=L
  1070. SEGINI ITBBE1
  1071. CALL LFCDEE(IORES,N,ITABE1,IRETOU,IFORM)
  1072. IF(IRETOU.NE.0) GO TO 1000
  1073. DO 260 I=1,L
  1074. IVB=ITABE1(I)
  1075. itlac(**)=ivb
  1076. 260 CONTINUE
  1077. SEGSUP ITBBE1
  1078. minouv=itlac(/1)
  1079. GOTO 1098
  1080. C **************************** MOT ***************************
  1081. 6027 CONTINUE
  1082. ITOTO=2
  1083. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1084. IF (IRETOU.NE.0) GO TO 1000
  1085. N = ILENA(2)
  1086. NNN=N
  1087. NN=ILENA(1)
  1088. SEGINI ITAMOT
  1089. MM=ITLAC(/1)+1
  1090. DO 271 I=1,N
  1091. ITLAC(**)=0
  1092. 271 CONTINUE
  1093. CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1094. IF(IRETOU.NE.0) GO TO 1000
  1095. CALL LFCDIE(IORES,N,ICOTA,IRETOU,IFORM)
  1096. IF(IRETOU.NE.0) GOTO 1000
  1097. M=1
  1098. DO 270 I=1,N
  1099. LL=ICOTA(I)
  1100. NN=ICOTA(I)-M+1
  1101. IVA=NN
  1102. CHA1(1:NN)=ITAMO(M:LL)
  1103. M=LL+1
  1104. CALL QUERAN(IRAT,'MOT ',IVA,XVA,CHA1(1:NN),LOGI,IOB)
  1105. ITLAC(MM+I-1) =IRAT
  1106. 270 CONTINUE
  1107. SEGSUP ITAMOT
  1108. GOTO 1098
  1109. C ****************************TEXTE *************************
  1110. 6028 CONTINUE
  1111. DO 280 IEL=1,IMAX1
  1112. ITOTO=1
  1113. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1114. IF (IRETOU.NE.0) GO TO 1000
  1115. N = ILENA(1)
  1116. SEGINI MTEXTE
  1117. NCART= N
  1118. CALL LFCDIC(IORES,MTEXT,IRETOU,IFORM)
  1119. SEGDES MTEXTE
  1120. IF(IRETOU.NE.0) GOTO 1000
  1121. ITLAC(**)=MTEXTE
  1122. 280 CONTINUE
  1123. GO TO 1098
  1124. C ******************************MLMOTS****************************
  1125. 6029 CONTINUE
  1126. DO 290 IEL=1,IMAX1
  1127. ITOTO=2
  1128. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1129. IF (IRETOU.NE.0) GO TO 1000
  1130. JGN = ILENA(1)
  1131. JGM = ILENA(2)
  1132. SEGINI MLMOTS
  1133. NN=JGN*JGM
  1134. NNN=0
  1135. SEGINI ITAMOT
  1136. CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1137. IF(IRETOU.NE.0) GOTO 1000
  1138. DO 56 IUH = 1,JGM
  1139. MOTS(IUH)= ITAMO((IUH-1)*JGN+1:IUH*JGN)
  1140. 56 CONTINUE
  1141. SEGSUP ITAMOT
  1142. SEGDES MLMOTS
  1143. ITLAC(**)=MLMOTS
  1144. 290 CONTINUE
  1145. GOTO 1098
  1146. C **************************MVECTE**********************************
  1147. 6030 CONTINUE
  1148. DO 300 IOB=1,IMAX1
  1149. IRETOU=0
  1150. CALL LIVECT (MVECTE,IORES,IRETOU,IFORM)
  1151. IF (IRETOU.NE.0) GO TO 1000
  1152. ITLAC(**)=MVECTE
  1153. 300 CONTINUE
  1154. GOTO 1098
  1155. C ************************* VECTD ***************************
  1156. 6031 CONTINUE
  1157. DO 310 IEL=1,IMAX1
  1158. ITOTO=1
  1159. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1160. IF (IRETOU.NE.0) GO TO 1000
  1161. INC = ILENA(1)
  1162. SEGINI MVECTD
  1163. CALL LFCDI2(IORES,N,VECTBB,IRETOU,IFORM)
  1164. SEGDES MVECTD
  1165. IF(IRETOU.NE.0) GOTO 1000
  1166. ITLAC(**)=MVECTD
  1167. 310 CONTINUE
  1168. GOTO 1098
  1169. C **************************** POINTS **************************
  1170. 6032 CONTINUE
  1171. ITOTO=1
  1172. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1173. IF (IRETOU.NE.0) GO TO 1000
  1174. N = ILENA(1)
  1175. M = ITLAC(/1)
  1176. IPLU=N-M
  1177. DO 322 I=1,IPLU
  1178. ITLAC(**)=0
  1179. 322 CONTINUE
  1180. CALL LFCDIE(IORES,N,ITLAC,IRETOU,IFORM)
  1181. IF(IRETOU.NE.0) GOTO 1000
  1182. DO 321 I=1,N
  1183. ITLAC(I)=ITLAC(I)+NBANC
  1184. 321 CONTINUE
  1185. GOTO 1098
  1186. C ****************************CONFIG *************************
  1187. 6033 CONTINUE
  1188. IAV=ITLAC(/1)
  1189. * write(6,*) ' imax1 iav ' , imax1,iav
  1190. iconul=0
  1191. ibon=0
  1192. DO 330 IEL=1,IMAX1
  1193. ITOTO=1
  1194. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1195. * write(6,*) ' lipil iel ilena(1)' , iel , ilena(1)
  1196. IF (IRETOU.NE.0) GO TO 1000
  1197. ILONG=ILENA(1)
  1198. * write(6,*) ' lipil iel ilong' , iel , ilong
  1199. if(ilong.eq.0) then
  1200. iconul=iconul+1
  1201. * nbpts=idim+1
  1202. * segini mcoor1
  1203. * itlac(**)=mcoor1
  1204. go to 330
  1205. endif
  1206. IDRES=IDIM
  1207. IDIM = 0
  1208. * write(6,*) ' iel ilong idres nbanc ', iel,ilong,idres,nbanc
  1209. NBPTS = ILONG+NBANC*(IDRES+1)
  1210. SEGINI MCOOR1
  1211. if(ibon.eq.0) ibon=mcoor1
  1212. IDIM=IDRES
  1213. IDIM11= (IDIM+1)*NBANC+1
  1214. CALL LFCDI2(IORES,ILONG,MCOOR1.XCOOR(IDIM11),IRETOU,IFORM)
  1215. IF(IRETOU.NE.0) GOTO 1000
  1216. DO 332 J=1,NBANC*(IDIM+1)
  1217. MCOOR1.XCOOR(J)=XCOOR(J)
  1218. 332 CONTINUE
  1219. * write(6,*) ' mcoor1' , mcoor1
  1220. SEGDES MCOOR1
  1221. ITLAC(**)=MCOOR1
  1222. 330 CONTINUE
  1223. IF(IONIVE.GT.9) THEN
  1224. if( iconul.ne.imax1) then
  1225. MCOOR1=Ibon
  1226. SEGACT MCOOR1*MOD
  1227. SEGDES MCOORD
  1228. MCOORD=MCOOR1
  1229. * write(6,*) ' mcoord ' , mcoord
  1230. endif
  1231. ENDIF
  1232. GO TO 1098
  1233. C *************************** MLCHPO *************************
  1234. 6034 CONTINUE
  1235. DO 340 IEL=1,IMAX1
  1236. ITOTO=1
  1237. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1238. IF (IRETOU.NE.0) GO TO 1000
  1239. N1 = ILENA(1)
  1240. SEGINI MLCHPO
  1241. ITLAC(**)=MLCHPO
  1242. CALL LFCDIE(IORES,N1,ICHPOI,IRETOU,IFORM)
  1243. SEGDES MLCHPO
  1244. IF(IRETOU.NE.0) GOTO 1000
  1245. 340 CONTINUE
  1246. GOTO 1098
  1247. C ****************************MBASEM*****************************
  1248. 6035 CONTINUE
  1249. NN=0
  1250. DO 3500 IEL=1,IMAX1
  1251. ITOTO=1
  1252. CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1253. IF (IRETOU.NE.0) GO TO 1000
  1254. N=ILENA(1)
  1255. SEGINI MBASEM
  1256. DO 3501 I=1,N
  1257. ITOTO=1
  1258. CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1259. IF (IRETOU.NE.0) GO TO 1000
  1260. NIBST=ILENA(1)
  1261. SEGINI MSOBAS
  1262. LISBAS(I)=MSOBAS
  1263. CALL LFCDIE(IORES,NIBST,IBSTRM(1),IRETOU,IFORM)
  1264. IF (IRETOU.NE.0) GO TO 1000
  1265. SEGDES MSOBAS
  1266. 3501 CONTINUE
  1267. SEGDES MBASEM
  1268. ITLAC(**)=MBASEM
  1269. 3500 CONTINUE
  1270. GOTO 1098
  1271. C *************************** PROCED ****************************
  1272. 6036 CONTINUE
  1273. IMAX1=NOBJN
  1274. SEGACT NOMM1,NOMM2
  1275. DO 636 IEL=1,IMAX1
  1276. SEGACT NOMM1,NOMM2
  1277. CHA1(1:8)=NOM2(IEL)
  1278. CHA1(9:16)=' '
  1279. CALL CQUOI(CHA1(1:8),CHA1(9:16),IVAL,XVA,CHARI,LOGI,IOBJ)
  1280. IF(IERR.EQ.0)THEN
  1281. ITLAC(**)= IOBJ
  1282. ELSE
  1283. IRETOU=1
  1284. GO TO 1000
  1285. ENDIF
  1286. 636 CONTINUE
  1287. GOTO 1097
  1288. C *************************** BLOC ****************************
  1289. 6037 CONTINUE
  1290. GOTO 1097
  1291. C *************************** MMODEL ****************************
  1292. 6038 CONTINUE
  1293. CALL LIMODL(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC)
  1294. IF (IRETOU.NE.0) GOTO 1000
  1295. GOTO 1098
  1296. C *************************** MCHAML ****************************
  1297. 6039 CONTINUE
  1298. CALL LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
  1299. IF (IRETOU.NE.0) GOTO 1000
  1300. GOTO 1098
  1301. C *************************** MINTE ****************************
  1302. 6040 CONTINUE
  1303. DO 2840 IEL=1,IMAX1
  1304. ITOTO=2
  1305. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1306. IF (IRETOU.NE.0) GO TO 1000
  1307. NBNO = ILENA(1)
  1308. NBPGAU = ILENA(2)
  1309. L=NBPGAU*4+6*NBPGAU*NBNO
  1310. SEGINI ITBBR1
  1311. CALL LFCDI2 (IORES,L,TABR1,IRETOU,IFORM)
  1312. IF(IRETOU.NE.0) GO TO 1000
  1313. SEGINI MINTE
  1314. I=0
  1315. DO 2841 IC=1,NBPGAU
  1316. I=I+1
  1317. POIGAU(IC)=TABR1(I)
  1318. I=I+1
  1319. QSIGAU(IC)=TABR1(I)
  1320. I=I+1
  1321. ETAGAU(IC)=TABR1(I)
  1322. I=I+1
  1323. DZEGAU(IC)=TABR1(I)
  1324. DO 28411 IB=1,NBNO
  1325. DO 28412 IA=1,6
  1326. I=I+1
  1327. SHPTOT(IA,IB,IC)=TABR1(I)
  1328. 28412 CONTINUE
  1329. 28411 CONTINUE
  1330. 2841 CONTINUE
  1331. SEGSUP ITBBR1
  1332. SEGDES MINTE
  1333. ITLAC(**)=MINTE
  1334. 2840 CONTINUE
  1335. GOTO 1098
  1336. C **************************NUAGE ***************************
  1337. 6041 CALL LINUAG(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1338. IF(IRETOU.NE.0) GO TO 1000
  1339. GOTO 1098
  1340. C ************************* MATRAK ********************************
  1341. 6042 CONTINUE
  1342. CALL LIMTAK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1343. IF (IRETOU.NE.0) GO TO 1000
  1344. GOTO 1098
  1345. C ************************* MATRIK ********************************
  1346. 6043 CONTINUE
  1347. CALL LIMTIK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1348. IF (IRETOU.NE.0) GO TO 1000
  1349. GOTO 1098
  1350. C ************************** METHODE *****************************
  1351. 6045 CONTINUE
  1352. DO 6945 I=1,IMAX1
  1353. ITLAC(**)=0
  1354. 6945 CONTINUE
  1355. CALL LFCDIE(IORES,1,ILENA,IRETOU,IFORM)
  1356. IF (IRETOU.NE.0) GO TO 1000
  1357. CALL LFCDIE(IORES,IMAX1,ITLAC,IRETOU,IFORM)
  1358. IF (IRETOU.NE.0) GO TO 1000
  1359. GOTO 1098
  1360. C ******************************************************************
  1361. C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
  1362. C
  1363. 1098 CONTINUE
  1364. C **** KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
  1365. CALL CREOB (ITYPE,NOMM1,NOMM2,ITLACC,mianc,mranc,mlanc)
  1366. IF(IFIN.EQ.1) GOTO 1000
  1367. GOTO 1097
  1368. ********************* ON REBOUCLE EN LECTURE **********************
  1369. 1000 CONTINUE
  1370. 1099 CONTINUE
  1371. 1001 CONTINUE
  1372. IRET=IRETOU
  1373. IF(NOMM1.NE.0) SEGSUP NOMM1
  1374. IF(NOMM2.NE.0) SEGSUP NOMM2
  1375. IF (ITBBM1.NE.0) SEGSUP ITBBM1,itbbc1
  1376. IF (ITBBM2.NE.0) SEGSUP ITBBM2,itbbc3
  1377. IF (ITBBE1.NE.0) SEGSUP ITBBE1
  1378. IF (ITBBE2.NE.0) SEGSUP ITBBE2,itbbc2
  1379. IF (ITBBR1.NE.0) SEGSUP ITBBR1
  1380. SEGDES ICOLAC
  1381. RETURN
  1382. C -------------------------------------------------------
  1383. 8000 FORMAT(16I5)
  1384. 8001 FORMAT(16(1X,A4))
  1385. END
  1386.  
  1387.  
  1388.  
  1389.  
  1390.  
  1391.  
  1392.  
  1393.  
  1394.  
  1395.  
  1396.  
  1397.  
  1398.  
  1399.  
  1400.  
  1401.  
  1402.  
  1403.  
  1404.  

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