Télécharger la plaquette Cast3M


fr en

Télécharger lipil.eso

Retour à la liste

Numérotation des lignes : 

lipil

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

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