Télécharger la plaquette Cast3M


fr en

Télécharger lipil.eso

Retour à la liste

Numérotation des lignes : 

lipil

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

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