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    OF166741  24/11/14    21:15:14     12078          
  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 LU',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.          IF (IONIVE.GE.25) THEN
  998.            NN=6*N
  999.          ELSE
  1000.            NN=3*N
  1001.          ENDIF
  1002.          SEGADJ ITBBE1
  1003.          CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  1004.          IF(IRETOU.NE.0) GOTO 1000
  1005.          NM=LDECA*N
  1006.          SEGADJ ITBBM1,itbbc1
  1007.          if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  1008.          if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  1009.          IF(IRETOU.NE.0) GOTO 1000
  1010.          IF (NIVEAU.LT.3) GOTO 221
  1011.          NM2=LDECA2*N
  1012.          SEGADJ ITBBM2,itbbc3
  1013.          if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  1014.          if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  1015.          IF(IRETOU.NE.0) GOTO 1000
  1016.  221     CONTINUE
  1017.          DO 3201 IN=1,N
  1018.             SEGINI KEVOLL
  1019.             IEVOLL(IN)=KEVOLL
  1020.             IF (IONIVE.GE.25) THEN
  1021.               I4=6*IN
  1022.               IPROGX=ITABE1(I4-5)
  1023.               IPROGY=ITABE1(I4-4)
  1024.               NUMEVX=ITABE1(I4-3)
  1025.               LSTYL =ITABE1(I4-2)
  1026.               MMARQ =ITABE1(I4-1)
  1027.               KTAIL =ITABE1(I4  )
  1028.             ELSE
  1029.               I4=3*IN
  1030.               IPROGX=ITABE1(I4-2)
  1031.               IPROGY=ITABE1(I4-1)
  1032.               NUMEVX=ITABE1(I4  )
  1033.               LSTYL = 1
  1034.               MMARQ = 0 
  1035.               KTAIL = 3
  1036.             ENDIF
  1037.             I7=LDECA*(IN-1)
  1038.             if (iform.ne.2) then
  1039.             WRITE(NOMEVX,FMT='(3A4)')(ITABM1(I7+I),I=1,3)
  1040.             WRITE(NOMEVY,FMT='(3A4)')(ITABM1(I7+I+3),I=1,3)
  1041.             WRITE (NUMEVY,FMT='(A4)') ITABM1(I7+7)
  1042.             IF(NIVEAU.GE.3) THEN
  1043.                I8=LDECA2*(IN-1)
  1044.                WRITE(TYPX,FMT='(2A4)')(ITABM1(I7+7+I),I=1,2)
  1045.                WRITE(TYPY,FMT='(2A4)')(ITABM1(I7+9+I),I=1,2)
  1046.                WRITE(KEVTEX,FMT='(18A4)') (ITABM2(I8+JPV),JPV=1,18)
  1047.             ENDIF
  1048.             else
  1049. *        write (6,*) ' evol itabc1 ',itabc1(i7+1),itabc1(i7+2)
  1050. *        write (6,*) ' evol itabc1 ',itabc1(i7+3+1),itabc1(i7+3+2)
  1051.             nomevx(1:4)=itabc1(i7+1)
  1052.             nomevx(5:8)=itabc1(i7+2)
  1053.             nomevx(9:12)=itabc1(i7+3)
  1054.             nomevy(1:4)=itabc1(i7+3+1)
  1055.             nomevy(5:8)=itabc1(i7+3+2)
  1056.             nomevy(9:12)=itabc1(i7+3+3)
  1057.             numevy=itabc1(i7+7)
  1058.             if (niveau.ge.3) then
  1059.             I8=LDECA2*(IN-1)
  1060.             typx(1:4)=itabc1(i7+7+1)
  1061.             typx(5:8)=itabc1(i7+7+2)
  1062.             typy(1:4)=itabc1(i7+9+1)
  1063.             typy(5:8)=itabc1(i7+9+2)
  1064.             do jpv=1,18
  1065.             kevtex(1+(jpv-1)*4:4*jpv)=itabc3(i8+jpv)
  1066.             enddo
  1067.             endif
  1068.             endif
  1069.  3202       CONTINUE
  1070.             SEGDES KEVOLL
  1071.  3201    CONTINUE
  1072.          SEGDES MEVOLL
  1073.          ITLAC(**)=MEVOLL
  1074.  3200 CONTINUE
  1075.       SEGSUP ITBBE1,ITBBM1,itbbc1
  1076.       SEGSUP ITBBM2,itbbc3
  1077.       GOTO 1098
  1078. C
  1079. C     **********************SUPERELE************************************
  1080.  6023 CONTINUE
  1081.       ITOTO=1
  1082.       DO 230 IEL=1,IMAX1
  1083.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1084.          IF (IRETOU.NE.0) GOTO 1000
  1085.          NTOTO=ILENA(1)
  1086.          SEGINI MSUPER
  1087.          ITLAC(**)=MSUPER
  1088.          CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  1089.          IF (IRETOU.NE.0) GOTO 1023
  1090.          MRIGTO=ILENA(1)
  1091.          MSUPEL=ILENA(2)
  1092.          MSURAI=ILENA(3)
  1093.          MBLOQU=ILENA(4)
  1094.          MSUMAS=ILENA(5)
  1095.          MCROUT=ILENA(6)
  1096.          SEGDES MSUPER
  1097.  230  CONTINUE
  1098.       GOTO 1098
  1099.  1023 CONTINUE
  1100.       SEGDES MSUPER
  1101.       GOTO 1000
  1102. C     ************************* LOGIQUE  ***************************
  1103.  6024 CONTINUE
  1104.       ITOTO=1
  1105.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1106.       IF (IRETOU.NE.0) GOTO 1000
  1107.       N  = ILENA(1)
  1108.       M=ITLAC(/1)
  1109.       do i=m+1,m+n
  1110.         itlac(**)=0
  1111.       enddo
  1112.       CALL LFCDIE (IORES,N,ITLAC(M+1),IRETOU,IFORM)
  1113.       IF(IRETOU.NE.0) GOTO 1000
  1114.       DO 242 I=m+1,m+n
  1115.          ITOTO=ITLAC(I)
  1116.          LOGI=.FALSE.
  1117.          IF(ITOTO.EQ.1)LOGI=.TRUE.
  1118.          CALL QUERAN (IRAT,'LOGIQUE ',IVB,XVA,CTYPE,LOGI,IOB)
  1119.          ITLAC(i) =IRAT
  1120.  242  CONTINUE
  1121.       mlnouv=itlac(/1)
  1122.       GOTO 1098
  1123. C     ******************************FLOTTANT**********************
  1124.  6025 CONTINUE
  1125.       ITOTO=1
  1126.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1127.       IF (IRETOU.NE.0) GOTO 1000
  1128.       N    =   ILENA(1)
  1129.       M=ITLAC(/1)
  1130.       L=N
  1131.       SEGINI ITBBR1
  1132.       CALL LFCDI2(IORES,N,TABR1,IRETOU,IFORM)
  1133.       IF(IRETOU.NE.0) GOTO 1000
  1134.       DO 250 I=1,N
  1135.          XVA=TABR1(I)
  1136.          CALL QUERAN(IRAT,'FLOTTANT',IVB,XVA,CTYPE,LOGI,IOB)
  1137.          ITLAC(**)=IRAT
  1138.  250  CONTINUE
  1139.       SEGSUP ITBBR1
  1140.       ITBBR1=0
  1141.       mrnouv=itlac(/1)
  1142.       GOTO 1098
  1143. C     **************************** ENTIER***************************
  1144.  6026 CONTINUE
  1145.       ITOTO=1
  1146.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1147.       IF (IRETOU.NE.0) GOTO 1000
  1148.       N    =   ILENA(1)
  1149.       M=ITLAC(/1)
  1150.       L=N
  1151.       NN=L
  1152.       SEGINI ITBBE1
  1153.       CALL LFCDEE(IORES,N,ITABE1,IRETOU,IFORM)
  1154.       IF(IRETOU.NE.0) GOTO 1000
  1155.       DO 260 I=1,L
  1156.          IVB=ITABE1(I)
  1157.          itlac(**)=ivb
  1158.  260  CONTINUE
  1159.       SEGSUP ITBBE1
  1160.       minouv=itlac(/1)
  1161.       GOTO 1098
  1162. C     **************************** MOT   ***************************
  1163.  6027 CONTINUE
  1164.       ITOTO=2
  1165.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1166.       IF (IRETOU.NE.0) GOTO 1000
  1167.       N    =   ILENA(2)
  1168.       NNN=N
  1169.       NN=ILENA(1)
  1170.       SEGINI ITAMOT
  1171.       MM=ITLAC(/1)+1
  1172.       DO 271 I=1,N
  1173.          ITLAC(**)=0
  1174.  271  CONTINUE
  1175.       CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1176.       IF(IRETOU.NE.0) GOTO 1000
  1177.       CALL LFCDIE(IORES,N,ICOTA,IRETOU,IFORM)
  1178.       IF(IRETOU.NE.0) GOTO 1000
  1179.       M=1
  1180.       DO 270 I=1,N
  1181.          LL=ICOTA(I)
  1182.          NN=ICOTA(I)-M+1
  1183.          IVA=NN
  1184.          CHA1(1:NN)=ITAMO(M:LL)
  1185.          M=LL+1
  1186.          CALL QUERAN(IRAT,'MOT     ',IVA,XVA,CHA1(1:NN),LOGI,IOB)
  1187.          if (irat.eq.0) call erreur(5)
  1188.          ITLAC(MM+I-1) =IRAT
  1189.  270  CONTINUE
  1190.       SEGSUP ITAMOT
  1191.       mmnouv=itlac(/1)
  1192.       GOTO 1098
  1193. C     ****************************TEXTE    *************************
  1194.  6028 CONTINUE
  1195.       DO 280 IEL=1,IMAX1
  1196.          ITOTO=1
  1197.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1198.          IF (IRETOU.NE.0) GOTO 1000
  1199.          N = ILENA(1)
  1200.          SEGINI MTEXTE
  1201.          NCART= N
  1202.          CALL LFCDIC(IORES,MTEXT,IRETOU,IFORM)
  1203.          SEGDES MTEXTE
  1204.          IF(IRETOU.NE.0) GOTO 1000
  1205.          ITLAC(**)=MTEXTE
  1206.  280  CONTINUE
  1207.       GOTO 1098
  1208. C     ******************************MLMOTS****************************
  1209.  6029 CONTINUE
  1210.       DO 290 IEL=1,IMAX1
  1211.          ITOTO=2
  1212.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1213.          IF (IRETOU.NE.0) GOTO 1000
  1214.          JGN = ILENA(1)
  1215.          JGM = ILENA(2)
  1216.          SEGINI MLMOTS
  1217.          NN=JGN*JGM
  1218.          NNN=0
  1219.          SEGINI ITAMOT
  1220.          CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1221.          IF(IRETOU.NE.0) GOTO 1000
  1222.          DO 56 IUH = 1,JGM
  1223.             MOTS(IUH)= ITAMO((IUH-1)*JGN+1:IUH*JGN)
  1224.  56      CONTINUE
  1225.          SEGSUP ITAMOT
  1226.          SEGDES MLMOTS
  1227.          ITLAC(**)=MLMOTS
  1228.  290  CONTINUE
  1229.       GOTO 1098
  1230. C    **************************MVECTE**********************************
  1231.  6030 CONTINUE
  1232.       DO 300 IOB=1,IMAX1
  1233.          IRETOU=0
  1234.          CALL LIVECT (MVECTE,IORES,IRETOU,IFORM)
  1235.          IF (IRETOU.NE.0) GOTO 1000
  1236.          ITLAC(**)=MVECTE
  1237.  300  CONTINUE
  1238.       GOTO 1098
  1239. C     ************************* VECTD    ***************************
  1240.  6031 CONTINUE
  1241.       DO 310 IEL=1,IMAX1
  1242.          ITOTO=1
  1243.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1244.          IF (IRETOU.NE.0) GOTO 1000
  1245.          INC  =   ILENA(1)
  1246.          SEGINI MVECTD
  1247.          CALL LFCDI2(IORES,N,VECTBB,IRETOU,IFORM)
  1248.          SEGDES MVECTD
  1249.          IF(IRETOU.NE.0) GOTO 1000
  1250.          ITLAC(**)=MVECTD
  1251.  310  CONTINUE
  1252.       GOTO 1098
  1253. C     **************************** POINTS **************************
  1254.  6032 CONTINUE
  1255.       ITOTO=1
  1256.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1257.       IF (IRETOU.NE.0) GOTO 1000
  1258.       N    =   ILENA(1)
  1259.       M = ITLAC(/1)
  1260.       IPLU=N-M
  1261.       DO 322 I=1,IPLU
  1262.          ITLAC(**)=0
  1263.  322  CONTINUE
  1264.       CALL LFCDIE(IORES,N,ITLAC,IRETOU,IFORM)
  1265.       IF(IRETOU.NE.0) GOTO 1000
  1266.       DO 321 I=1,N
  1267.          ITLAC(I)=ITLAC(I)+NBANC
  1268.  321  CONTINUE
  1269.       GOTO 1098
  1270. C     ****************************CONFIG   *************************
  1271.  6033 CONTINUE
  1272.       IAV=ITLAC(/1)
  1273. *      write(6,*) ' imax1 iav ' , imax1,iav
  1274.       iconul=0
  1275.       ibon=0
  1276.       DO 330 IEL=1,IMAX1
  1277.          ITOTO=1
  1278.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1279. *         write(6,*) ' lipil iel  ilena(1)' , iel , ilena(1)
  1280.          IF (IRETOU.NE.0) GOTO 1000
  1281.          ILONG=ILENA(1)
  1282. *         write(6,*) ' lipil iel  ilong' , iel , ilong
  1283.          if(ilong.eq.0) then
  1284.          iconul=iconul+1
  1285. *           nbpts=idim+1
  1286. *           segini mcoor1
  1287. *           itlac(**)=mcoor1
  1288.            GOTO 330
  1289.          endif
  1290.          IDRES=IDIM
  1291.          IDIM  = 0
  1292. *         write(6,*) ' iel ilong idres nbanc ', iel,ilong,idres,nbanc
  1293.          NBPTS = ILONG+NBANC*(IDRES+1)
  1294.          SEGINI MCOOR1
  1295.          if(ibon.eq.0) ibon=mcoor1
  1296.          IDIM=IDRES
  1297.          IDIM11= (IDIM+1)*NBANC+1
  1298.          CALL LFCDI2(IORES,ILONG,MCOOR1.XCOOR(IDIM11),IRETOU,IFORM)
  1299.          IF(IRETOU.NE.0) GOTO 1000
  1300.          DO 332 J=1,NBANC*(IDIM+1)
  1301.             MCOOR1.XCOOR(J)=XCOOR(J)
  1302.  332     CONTINUE
  1303. *         write(6,*) ' mcoor1' , mcoor1
  1304.          SEGDES MCOOR1
  1305.          ITLAC(**)=MCOOR1
  1306.  330  CONTINUE
  1307.       IF(IONIVE.GT.9) THEN
  1308.          if( iconul.ne.imax1) then
  1309.           MCOOR1=Ibon
  1310.           SEGACT MCOOR1*MOD
  1311.           SEGDES MCOORD
  1312.           MCOORD=MCOOR1
  1313.           nbpts=xcoor(/1)/(idim+1)
  1314. *         write(6,*) ' mcoord ' , mcoord
  1315.          endif
  1316.       ENDIF
  1317.       GOTO 1098
  1318. C     *************************** MLCHPO   *************************
  1319.  6034 CONTINUE
  1320.       DO 340 IEL=1,IMAX1
  1321.          ITOTO=1
  1322.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1323.          IF (IRETOU.NE.0) GOTO 1000
  1324.          N1    =   ILENA(1)
  1325.          SEGINI MLCHPO
  1326.          ITLAC(**)=MLCHPO
  1327.          CALL LFCDIE(IORES,N1,ICHPOI,IRETOU,IFORM)
  1328.          SEGDES MLCHPO
  1329.          IF(IRETOU.NE.0) GOTO 1000
  1330.  340  CONTINUE
  1331.       GOTO 1098
  1332. C     ****************************MBASEM*****************************
  1333.  6035 CONTINUE
  1334.       NN=0
  1335.       DO 3500 IEL=1,IMAX1
  1336.          ITOTO=1
  1337.          CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1338.          IF (IRETOU.NE.0) GOTO 1000
  1339.          N=ILENA(1)
  1340.          SEGINI MBASEM
  1341.          DO 3501 I=1,N
  1342.             ITOTO=1
  1343.             CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1344.             IF (IRETOU.NE.0) GOTO 1000
  1345.             NIBST=ILENA(1)
  1346.             SEGINI MSOBAS
  1347.             LISBAS(I)=MSOBAS
  1348.             CALL LFCDIE(IORES,NIBST,IBSTRM(1),IRETOU,IFORM)
  1349.             IF (IRETOU.NE.0) GOTO 1000
  1350.             SEGDES MSOBAS
  1351.  3501    CONTINUE
  1352.          SEGDES MBASEM
  1353.          ITLAC(**)=MBASEM
  1354.  3500 CONTINUE
  1355.       GOTO 1098
  1356. C     *************************** PROCED ****************************
  1357.  6036 CONTINUE
  1358. c       ========= LES PROCEDURES NE SONT PAS SAUVEES =========
  1359. c       IMAX1=NOBJN
  1360. c       SEGACT NOMM1,NOMM2
  1361. c       DO 636 IEL=1,IMAX1
  1362. c          SEGACT NOMM1,NOMM2
  1363. c          CHA1(1:8)=NOM2(IEL)
  1364. c          CHA1(9:16)=' '
  1365. c          CALL CQUOI(CHA1(1:8),CHA1(9:16),IVAL,XVA,CHARI,LOGI,IOBJ)
  1366. c          IF(IERR.EQ.0)THEN
  1367. c             ITLAC(**)= IOBJ
  1368. c          ELSE
  1369. c             IRETOU=1
  1370. c             GOTO 1000
  1371. c          ENDIF
  1372. c  636  CONTINUE
  1373.       GOTO 1097
  1374. C     *************************** BLOC   ****************************
  1375.  6037 CONTINUE
  1376.       GOTO 1097
  1377. C     *************************** MMODEL ****************************
  1378.  6038 CONTINUE
  1379.       CALL LIMODL(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC)
  1380.       IF (IRETOU.NE.0) GOTO 1000
  1381.       GOTO 1098
  1382. C     *************************** MCHAML ****************************
  1383.  6039 CONTINUE
  1384.       CALL LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
  1385.       IF (IRETOU.NE.0) GOTO 1000
  1386.       GOTO 1098
  1387. C     *************************** MINTE  ****************************
  1388.  6040 CONTINUE
  1389.       DO 2840 IEL=1,IMAX1
  1390.          ITOTO=2
  1391.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1392.          IF (IRETOU.NE.0) GOTO 1000
  1393.          NBNO   = ILENA(1)
  1394.          NBPGAU = ILENA(2)
  1395.          L=NBPGAU*4+6*NBPGAU*NBNO
  1396.          SEGINI ITBBR1
  1397.          CALL LFCDI2 (IORES,L,TABR1,IRETOU,IFORM)
  1398.          IF(IRETOU.NE.0) GOTO 1000
  1399.          SEGINI MINTE
  1400.          I=0
  1401.          DO 2841 IC=1,NBPGAU
  1402.             I=I+1
  1403.             POIGAU(IC)=TABR1(I)
  1404.             I=I+1
  1405.             QSIGAU(IC)=TABR1(I)
  1406.             I=I+1
  1407.             ETAGAU(IC)=TABR1(I)
  1408.             I=I+1
  1409.             DZEGAU(IC)=TABR1(I)
  1410.             DO 28411 IB=1,NBNO
  1411.                DO 28412 IA=1,6
  1412.                   I=I+1
  1413.                   SHPTOT(IA,IB,IC)=TABR1(I)
  1414. 28412          CONTINUE
  1415. 28411       CONTINUE
  1416.  2841    CONTINUE
  1417.          SEGSUP ITBBR1
  1418.          SEGDES MINTE
  1419.          ITLAC(**)=MINTE
  1420.  2840 CONTINUE
  1421.       GOTO 1098
  1422. C    **************************NUAGE ***************************
  1423.  6041 CALL LINUAG(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1424.       IF(IRETOU.NE.0) GOTO 1000
  1425.       GOTO 1098
  1426. C     ************************* MATRAK ********************************
  1427.  6042 CONTINUE
  1428.       CALL LIMTAK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1429.       IF (IRETOU.NE.0) GOTO 1000
  1430.       GOTO 1098
  1431. C     ************************* MATRIK ********************************
  1432.  6043 CONTINUE
  1433.       CALL LIMTIK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1434.       IF (IRETOU.NE.0) GOTO 1000
  1435.       GOTO 1098
  1436. C  **************************  METHODE *****************************
  1437.  6045 CONTINUE
  1438.       DO 6945 I=1,IMAX1
  1439.          ITLAC(**)=0
  1440.  6945 CONTINUE
  1441.       CALL LFCDIE(IORES,1,ILENA,IRETOU,IFORM)
  1442.       IF (IRETOU.NE.0) GOTO 1000
  1443.       CALL LFCDIE(IORES,IMAX1,ITLAC,IRETOU,IFORM)
  1444.       IF (IRETOU.NE.0) GOTO 1000
  1445.       GOTO 1098
  1446. C     ************************* IELVAL ********************************
  1447.  6048 CONTINUE
  1448.       CALL LIIELV(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1449.       IF (IRETOU.NE.0) GOTO 1000
  1450.       GOTO 1098
  1451. C     ************************ LISTOBJE *******************************
  1452.  6050 CONTINUE
  1453.       DO 500 IEL=1,IMAX1
  1454.          ITOTO=1
  1455.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1456.          IF (IRETOU.NE.0) GOTO 1000
  1457.          NOBJ  =   ILENA(1)
  1458.          SEGINI, MLOBJE
  1459.          ITLAC(**)=MLOBJE
  1460.          NM2 = 2
  1461.          SEGINI, ITBBM2,itbbc3
  1462.          IF (IFORM.NE.2) THEN
  1463.            CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  1464.            IF(IRETOU.NE.0) GOTO 1000
  1465.            WRITE (TYPOBJ,FMT='(2A4)') ITABM2(1),ITABM2(2)
  1466.          ELSE
  1467.            ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  1468. C          write (6,*) ' TYPOBJ itabc3 ',itabc3(1),itabc3(2)
  1469.            TYPOBJ(1:4)=itabc3(1)
  1470.            TYPOBJ(5:8)=itabc3(2)
  1471.          ENDIF
  1472.          CALL LFCDIE(IORES,NOBJ,LISOBJ,IRETOU,IFORM)
  1473.          SEGDES, MLOBJE
  1474.          IF(IRETOU.NE.0) GOTO 1000
  1475.  500  CONTINUE
  1476.  
  1477.       GOTO 1098
  1478. C     ******************************************************************
  1479. C     *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
  1480. C
  1481.  1098 CONTINUE
  1482. C  ****  KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
  1483.       CALL CREOB (ITYPE,NOMM1,NOMM2,ITLACC,mianc,mranc,mlanc,mmanc)
  1484.       IF(IFIN.EQ.1) GOTO 1000
  1485.       GOTO 1097
  1486. ********************* ON REBOUCLE EN LECTURE **********************
  1487.  1000 CONTINUE
  1488.  1099 CONTINUE
  1489.  1001 CONTINUE
  1490.       IRET=IRETOU
  1491.       IF(NOMM1.NE.0) SEGSUP NOMM1
  1492.       IF(NOMM2.NE.0) SEGSUP NOMM2
  1493.       IF (ITBBM1.NE.0) SEGSUP ITBBM1,itbbc1
  1494.       IF (ITBBM2.NE.0) SEGSUP ITBBM2,itbbc3
  1495.       IF (ITBBE1.NE.0) SEGSUP ITBBE1
  1496.       IF (ITBBE2.NE.0) SEGSUP ITBBE2,itbbc2
  1497.       IF (ITBBR1.NE.0) SEGSUP ITBBR1
  1498.       SEGDES ICOLAC
  1499.       RETURN
  1500. C -------------------------------------------------------
  1501.  8000 FORMAT(16I5)
  1502.  8001 FORMAT(16(1X,A4))
  1503.       END
  1504.  
  1505.  
  1506.  

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