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

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