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