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  26/04/30    21:15:50     12529          
  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 = 28
  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.          RIGREL=0
  683.          segini xmatri
  684.          symre=ilena(4)
  685.          if (symre.eq.0.and.nligrp.eq.nligrd) then
  686. *  cas symetrique on ne lit que la partie triangulaire
  687.           laux=nligrp*(nligrp+1)/2
  688.           segini xmaaux
  689.           call lfcdi2(iores,laux*nelrig,reaux,
  690.      >          iretou,iform)
  691.           do k=1,nelrig
  692.             ip=0
  693.             do j=1,nligrp
  694.               do i=1,j
  695.                re(i,j,k)=reaux(ip+i,k)
  696.                re(j,i,k)=reaux(ip+i,k)
  697.               enddo
  698.               ip=ip+j
  699.             enddo
  700.           enddo
  701.           segsup xmaaux
  702.          else
  703. *  cas general on lit tout
  704.            call lfcdi2(iores,lval,re,iretou,iform)
  705.          endif
  706.          itlac(**)=xmatri
  707.          SEGDES xMATRI
  708.  2300 CONTINUE
  709.       GOTO 1098
  710. C     ***************************** MJONCT *****************************
  711.  6014 CONTINUE
  712.       CALL LIJONC (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  713.       IF (IRETOU.NE.0) GOTO 1000
  714.       GOTO 1098
  715. C     ***************************** MATTAC *****************************
  716.  6015 CONTINUE
  717.       CALL LIATTA (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  718.       IF (IRETOU.NE.0) GOTO 1000
  719.       GOTO 1098
  720. C     ***************************** MMATRI *****************************
  721.  6016 CONTINUE
  722.       CALL LIMMAT (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  723.       IF (IRETOU.NE.0) GOTO 1000
  724.       GOTO 1098
  725. C     *************************MDEFOR*******************************
  726.  6017 CONTINUE
  727.       NN=0
  728.       SEGINI ITBBE1
  729.       DO 2700 IEL=1,IMAX1
  730. C     READ(IORES,8000,END=1000,ERR=1000) NDEF
  731.          ITOTO=1
  732.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  733.          IF (IRETOU.NE.0) GOTO 1000
  734.          NDEF =   ILENA(1)
  735.          SEGINI MDEFOR
  736.          ITLAC(**)=MDEFOR
  737.          CALL LFCDI2(IORES,NDEF,AMPL,IRETOU,IFORM)
  738.          IF(IRETOU.NE.0) GOTO 1000
  739. C     READ(IORES,8000,END=1000,ERR=1000)(IELDEF(I),I=1,NDEF),(ICHDEF(I),
  740. C    1 I=1,NDEF), (JCOUL(I),I=1,NDEF)
  741.          NN=7*NDEF
  742.          SEGADJ  ITBBE1
  743.          CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
  744.          IF (IRETOU.NE.0) GOTO 1000
  745.          CALL JDANSI ( IELDEF(1),ITABE1(1),NDEF)
  746.          CALL JDANSI ( ICHDEF(1),ITABE1(NDEF +1),NDEF)
  747.          CALL JDANSI ( JCOUL(1),ITABE1(2*NDEF+1),NDEF)
  748.          CALL JDANSI ( MTVECT(1),ITABE1(3*NDEF+1),NDEF)
  749.          CALL JDANSI ( MDCHP(1),ITABE1(4*NDEF+1),NDEF)
  750.          CALL JDANSI ( MDCHEL(1),ITABE1(5*NDEF+1),NDEF)
  751.          CALL JDANSI ( MDMODE(1),ITABE1(6*NDEF+1),NDEF)
  752.          SEGDES MDEFOR
  753.  2700 CONTINUE
  754.       SEGSUP ITBBE1
  755.       GOTO 1098
  756. C     ******************************MLREEL**************************
  757.  6018 CONTINUE
  758.       DO 2800 IEL=1,IMAX1
  759. C     READ(IORES,8000,END=1000,ERR=1000)N
  760.          ITOTO=1
  761.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  762.          IF (IRETOU.NE.0) GOTO 1000
  763.          N    =   ILENA(1)
  764.          JG=N
  765.          SEGINI MLREEL
  766.          CALL LFCDI2(IORES,N,PROG,IRETOU,IFORM)
  767.          SEGDES MLREEL
  768.          IF(IRETOU.NE.0) GOTO 1000
  769.          ITLAC(**)=MLREEL
  770.  2800 CONTINUE
  771.       GOTO 1098
  772. C     ******************************MLENTI****************************
  773.  6019 CONTINUE
  774.       DO 2900 IEL=1,IMAX1
  775.          ITOTO=1
  776.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  777.          IF (IRETOU.NE.0) GOTO 1000
  778.          N    =   ILENA(1)
  779.          JG=N
  780.          SEGINI MLENTI
  781.          CALL LFCDEE(IORES,N,LECT,IRETOU,IFORM)
  782.          SEGDES MLENTI
  783.          IF(IRETOU.NE.0) GOTO 1000
  784.          ITLAC(**)=MLENTI
  785.  2900 CONTINUE
  786.       GOTO 1098
  787. C     ****************************MCHARG******************************
  788.  6020 CONTINUE
  789.       NN=0
  790.       NM=0
  791.       NM2=0
  792.       SEGINI ITBBM1,itbbc1
  793.       SEGINI ITBBM2,itbbc3
  794.       SEGINI ITBBM3,itbbc4
  795.       SEGINI ITBBM4,itbbc5
  796.       SEGINI ITBBE1
  797.       SEGINI ITBBE2,itbbc2
  798.       DO 3000 IEL=1,IMAX1
  799. C        READ(IORES,8000,END=1000,ERR=1000)N
  800.          IF(IONIVE.LE.6) THEN
  801.             ITOTO=1
  802.             CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  803.             IF (IRETOU.NE.0) GOTO 1000
  804.             N = ILENA(1)
  805.             SEGINI MCHARG
  806.             NM=2*N
  807.             SEGADJ ITBBM1,itbbc1
  808.             if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  809.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  810.             IF(IRETOU.NE.0) GOTO 1000
  811.             NN=3*N
  812.             SEGADJ ITBBE1
  813.             CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  814.             IF(IRETOU.NE.0) GOTO 1000
  815.             DO 3001 I=1,N
  816. c               WRITE (CHANOM(I),FMT='(I4)') I
  817.                CHANOM(I)='    '
  818.                SEGINI ICHARG
  819.                KCHARG(I)=ICHARG
  820.                I2=2*I
  821.                I3=3*I
  822.                if (iform.ne.2) then
  823.                 WRITE (CHANAT(I),FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  824.                else
  825.                 chanat(i)(1:4)=itabc1(i2-1)
  826.                 chanat(i)(5:8)=itabc1(i2)
  827.                endif
  828.                CHATYP='CHPOINT '
  829.                ICHPO1=ITABE1(I3-2)
  830.                ICHPO2=ITABE1(I3-1)
  831.                ICHPO3=ITABE1(I3)
  832.                SEGDES ICHARG
  833.  3001       CONTINUE
  834.          ELSE IF (IONIVE.GE.7.AND.IONIVE.LE.10) THEN
  835.             ITOTO=1
  836.             CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  837.             IF (IRETOU.NE.0) GOTO 1000
  838.             N = ILENA(1)
  839.             SEGINI MCHARG
  840.             NN=2*N
  841.             SEGADJ ITBBE2,itbbc2
  842.             if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
  843.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
  844.             IF(IRETOU.NE.0) GOTO 1000
  845.             NM2=N
  846.             SEGADJ ITBBM2,itbbc3
  847.             if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  848.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  849.             IF(IRETOU.NE.0) GOTO 1000
  850.             NM=2*N
  851.             SEGADJ ITBBM1,itbbc1
  852.             if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  853.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  854.             IF(IRETOU.NE.0) GOTO 1000
  855.             NN=3*N
  856.             SEGADJ ITBBE1
  857.             CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  858.             IF(IRETOU.NE.0) GOTO 1000
  859.             DO 3002 I=1,N
  860.                SEGINI ICHARG
  861.                KCHARG(I)=ICHARG
  862.                I2=2*I
  863.                I3=3*I
  864.                if (iform.ne.2) then
  865.                WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  866.                WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
  867.                WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
  868.                else
  869.                chatyp(1:4)=itabc1(i2-1)
  870.                chatyp(5:8)=itabc1(i2)
  871.                chanat(i)(1:4)=itabc2(i2-1)
  872.                chanat(i)(5:8)=itabc2(i2)
  873.                chanom(i)=itabc3(i)
  874.                endif
  875. c initialise par defaut
  876.                CHAMOB(I) = 'STAT'
  877.                CHALIE(I) = 'LIE '
  878. c..
  879.                ICHPO1=ITABE1(I3-2)
  880.                ICHPO2=ITABE1(I3-1)
  881.                ICHPO3=ITABE1(I3)
  882.                SEGDES ICHARG
  883.  3002       CONTINUE
  884.          ELSE
  885.             ITOTO=1
  886.             CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  887.             IF (IRETOU.NE.0) GOTO 1000
  888.             N = ILENA(1)
  889.             SEGINI MCHARG
  890.             NN=2*N
  891.             SEGADJ ITBBE2,itbbc2
  892.             if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
  893.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
  894.             IF(IRETOU.NE.0) GOTO 1000
  895.             NM2=N
  896.             SEGADJ ITBBM2,itbbc3
  897.             if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  898.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  899.             IF(IRETOU.NE.0) GOTO 1000
  900.             SEGADJ ITBBM3,itbbc4
  901.             if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM3,IRETOU,IFORM)
  902.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc4(1)(1:nm2*4))
  903.             IF(IRETOU.NE.0) GOTO 1000
  904.             SEGADJ ITBBM4,itbbc5
  905.             if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM4,IRETOU,IFORM)
  906.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc5(1)(1:nm2*4))
  907.             IF(IRETOU.NE.0) GOTO 1000
  908.             NM=2*N
  909.             SEGADJ ITBBM1,itbbc1
  910.             if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  911.             if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  912.             IF(IRETOU.NE.0) GOTO 1000
  913.             NN=7*N
  914.             SEGADJ ITBBE1
  915.             CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  916.             IF(IRETOU.NE.0) GOTO 1000
  917.             DO 3003 I=1,N
  918.                SEGINI ICHARG
  919.                KCHARG(I)=ICHARG
  920.                I2=2*I
  921.                I3=7*I
  922.                if (iform.ne.2) then
  923.                WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  924.                WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
  925.                WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
  926.                WRITE (CHAMOB(I),FMT='(1A4)') ITABM3(I)
  927.                WRITE (CHALIE(I),FMT='(1A4)') ITABM4(I)
  928.                else
  929.                chatyp(1:4)=itabc1(i2-1)
  930.                chatyp(5:8)=itabc1(i2)
  931.                chanat(i)(1:4)=itabc2(i2-1)
  932.                chanat(i)(5:8)=itabc2(i2)
  933.                chanom(i)=itabc3(i)
  934.                chamob(i)=itabc4(i)
  935.                chalie(i)=itabc5(i)
  936.                endif
  937.                ICHPO1=ITABE1(I3-6)
  938.                ICHPO2=ITABE1(I3-5)
  939.                ICHPO3=ITABE1(I3-4)
  940.                ICHPO4=ITABE1(I3-3)
  941.                ICHPO5=ITABE1(I3-2)
  942.                ICHPO6=ITABE1(I3-1)
  943.                ICHPO7=ITABE1(I3)
  944.                if (ionive.le.19) then
  945. **                if (ICHPO4.gt.0) then
  946.                  if (chamob(i).eq.'TRAN') then
  947.                    ipt1 = ICHPO4 + nbanc
  948.                    CALL CRELEM(ipt1)
  949. C*? C On verifie s'il n'a pas deja ete preconditionne.
  950. C*?                    CALL CRECH1(ipt1,1)
  951.                    segdes,ipt1
  952.                    ICHPO4 = ipt1
  953.                  else if (chamob(i).eq.'ROTA') then
  954.                    ipt1 = ICHPO4 + nbanc
  955.                    CALL CRELEM(ipt1)
  956. C*? C On verifie s'il n'a pas deja ete preconditionne.
  957. C*?                    CALL CRECH1(ipt1,1)
  958.                    segdes,ipt1
  959.                    ICHPO4 = ipt1
  960.                    if (ICHPO5.gt.0) then
  961.                      ipt1 = ICHPO5 + nbanc
  962.                      CALL CRELEM(ipt1)
  963. C*? C On verifie s'il n'a pas deja ete preconditionne.
  964. C*?                      CALL CRECH1(ipt1,1)
  965.                      segdes,ipt1
  966.                      ICHPO5 = ipt1
  967.                    endif
  968.                  endif
  969. **                endif
  970.                endif
  971.                SEGDES ICHARG
  972.  3003       CONTINUE
  973.          ENDIF
  974.          SEGDES MCHARG
  975.          ITLAC(**)=MCHARG
  976.  3000 CONTINUE
  977.       SEGSUP ITBBM1,itbbc1,ITBBE1,ITBBM2,itbbc3,ITBBM3,itbbc4,
  978.      >       ITBBM4,itbbc5,ITBBE2,itbbc2
  979.       GOTO 1098
  980. C     ****************************        **************************
  981.  6021 CONTINUE
  982.       GOTO 1098
  983. C     *****************************MEVOLL***************************
  984.  6022 CONTINUE
  985.       NN=0
  986.       NM=0
  987.       NM2=20
  988.       SEGINI ITBBM2,itbbc3
  989.       SEGINI ITBBE1,ITBBM1,itbbc1
  990.       LDECA=7
  991.       IF(NIVEAU.GE.3) LDECA=11
  992.       LDECA2=18
  993.       DO 3200 IEL=1,IMAX1
  994.          ITOTO=1
  995.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  996.          IF (IRETOU.NE.0) GOTO 1000
  997.          N    =   ILENA(1)
  998.          NM2=20
  999.          SEGADJ ITBBM2,itbbc3
  1000.          SEGINI MEVOLL
  1001.          if (iform.ne.2) then
  1002.          CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  1003.          IF(IRETOU.NE.0) GOTO 1000
  1004.          WRITE (ITYEVO,FMT='(2A4)') ITABM2(1),ITABM2(2)
  1005.          WRITE(IEVTEX,FMT='(18A4)') (ITABM2(I+2),I=1,18)
  1006.          else
  1007.          ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  1008. *        write (6,*) ' evol itabc3 ',itabc3(1),itabc3(2)
  1009.          ityevo(1:4)=itabc3(1)
  1010.          ityevo(5:8)=itabc3(2)
  1011.          do jpv=1,18
  1012.          ievtex(1+4*(jpv-1):4*jpv)=itabc3(jpv+2)
  1013.          enddo
  1014.          endif
  1015.          IF (IONIVE.GE.25) THEN
  1016.            NN=6*N
  1017.          ELSE
  1018.            NN=3*N
  1019.          ENDIF
  1020.          SEGADJ ITBBE1
  1021.          CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  1022.          IF(IRETOU.NE.0) GOTO 1000
  1023.          NM=LDECA*N
  1024.          SEGADJ ITBBM1,itbbc1
  1025.          if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  1026.          if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  1027.          IF(IRETOU.NE.0) GOTO 1000
  1028.          IF (NIVEAU.LT.3) GOTO 221
  1029.          NM2=LDECA2*N
  1030.          SEGADJ ITBBM2,itbbc3
  1031.          if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  1032.          if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  1033.          IF(IRETOU.NE.0) GOTO 1000
  1034.  221     CONTINUE
  1035.          DO 3201 IN=1,N
  1036.             SEGINI KEVOLL
  1037.             IEVOLL(IN)=KEVOLL
  1038.             IF (IONIVE.GE.25) THEN
  1039.               I4=6*IN
  1040.               IPROGX=ITABE1(I4-5)
  1041.               IPROGY=ITABE1(I4-4)
  1042.               NUMEVX=ITABE1(I4-3)
  1043.               LSTYL =ITABE1(I4-2)
  1044.               MMARQ =ITABE1(I4-1)
  1045.               KTAIL =ITABE1(I4  )
  1046.             ELSE
  1047.               I4=3*IN
  1048.               IPROGX=ITABE1(I4-2)
  1049.               IPROGY=ITABE1(I4-1)
  1050.               NUMEVX=ITABE1(I4  )
  1051.             ENDIF
  1052.             I7=LDECA*(IN-1)
  1053.             if (iform.ne.2) then
  1054.             WRITE(NOMEVX,FMT='(3A4)')(ITABM1(I7+I),I=1,3)
  1055.             WRITE(NOMEVY,FMT='(3A4)')(ITABM1(I7+I+3),I=1,3)
  1056.             WRITE (NUMEVY,FMT='(A4)') ITABM1(I7+7)
  1057.             IF(NIVEAU.GE.3) THEN
  1058.                I8=LDECA2*(IN-1)
  1059.                WRITE(TYPX,FMT='(2A4)')(ITABM1(I7+7+I),I=1,2)
  1060.                WRITE(TYPY,FMT='(2A4)')(ITABM1(I7+9+I),I=1,2)
  1061.                WRITE(KEVTEX,FMT='(18A4)') (ITABM2(I8+JPV),JPV=1,18)
  1062.             ENDIF
  1063.             else
  1064. *        write (6,*) ' evol itabc1 ',itabc1(i7+1),itabc1(i7+2)
  1065. *        write (6,*) ' evol itabc1 ',itabc1(i7+3+1),itabc1(i7+3+2)
  1066.             nomevx(1:4)=itabc1(i7+1)
  1067.             nomevx(5:8)=itabc1(i7+2)
  1068.             nomevx(9:12)=itabc1(i7+3)
  1069.             nomevy(1:4)=itabc1(i7+3+1)
  1070.             nomevy(5:8)=itabc1(i7+3+2)
  1071.             nomevy(9:12)=itabc1(i7+3+3)
  1072.             numevy=itabc1(i7+7)
  1073.             if (niveau.ge.3) then
  1074.             I8=LDECA2*(IN-1)
  1075.             typx(1:4)=itabc1(i7+7+1)
  1076.             typx(5:8)=itabc1(i7+7+2)
  1077.             typy(1:4)=itabc1(i7+9+1)
  1078.             typy(5:8)=itabc1(i7+9+2)
  1079.             do jpv=1,18
  1080.             kevtex(1+(jpv-1)*4:4*jpv)=itabc3(i8+jpv)
  1081.             enddo
  1082.             endif
  1083.             endif
  1084.  3202       CONTINUE
  1085.             SEGDES KEVOLL
  1086.  3201    CONTINUE
  1087.          SEGDES MEVOLL
  1088.          ITLAC(**)=MEVOLL
  1089.  3200 CONTINUE
  1090.       SEGSUP ITBBE1,ITBBM1,itbbc1
  1091.       SEGSUP ITBBM2,itbbc3
  1092.       GOTO 1098
  1093. C
  1094. C     **********************SUPERELE************************************
  1095.  6023 CONTINUE
  1096.       ITOTO=1
  1097.       DO 230 IEL=1,IMAX1
  1098.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1099.          IF (IRETOU.NE.0) GOTO 1000
  1100.          NTOTO=ILENA(1)
  1101.          SEGINI MSUPER
  1102.          ITLAC(**)=MSUPER
  1103.          CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  1104.          IF (IRETOU.NE.0) GOTO 1023
  1105.          MRIGTO=ILENA(1)
  1106.          MSUPEL=ILENA(2)
  1107.          MSURAI=ILENA(3)
  1108.          MBLOQU=ILENA(4)
  1109.          MSUMAS=ILENA(5)
  1110.          MCROUT=ILENA(6)
  1111.          SEGDES MSUPER
  1112.  230  CONTINUE
  1113.       GOTO 1098
  1114.  1023 CONTINUE
  1115.       SEGDES MSUPER
  1116.       GOTO 1000
  1117. C     ************************* LOGIQUE  ***************************
  1118.  6024 CONTINUE
  1119.       ITOTO=1
  1120.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1121.       IF (IRETOU.NE.0) GOTO 1000
  1122.       N  = ILENA(1)
  1123.       M=ITLAC(/1)
  1124.       do i=m+1,m+n
  1125.         itlac(**)=0
  1126.       enddo
  1127.       CALL LFCDIE (IORES,N,ITLAC(M+1),IRETOU,IFORM)
  1128.       IF(IRETOU.NE.0) GOTO 1000
  1129.       DO 242 I=m+1,m+n
  1130.          ITOTO=ITLAC(I)
  1131.          LOGI=.FALSE.
  1132.          IF(ITOTO.EQ.1)LOGI=.TRUE.
  1133.          CALL QUERAN (IRAT,'LOGIQUE ',IVB,XVA,CTYPE,LOGI,IOB)
  1134.          ITLAC(i) =IRAT
  1135.  242  CONTINUE
  1136.       mlnouv=itlac(/1)
  1137.       GOTO 1098
  1138. C     ******************************FLOTTANT**********************
  1139.  6025 CONTINUE
  1140.       ITOTO=1
  1141.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1142.       IF (IRETOU.NE.0) GOTO 1000
  1143.       N    =   ILENA(1)
  1144.       M=ITLAC(/1)
  1145.       L=N
  1146.       SEGINI ITBBR1
  1147.       CALL LFCDI2(IORES,N,TABR1,IRETOU,IFORM)
  1148.       IF(IRETOU.NE.0) GOTO 1000
  1149.       DO 250 I=1,N
  1150.          XVA=TABR1(I)
  1151.          CALL QUERAN(IRAT,'FLOTTANT',IVB,XVA,CTYPE,LOGI,IOB)
  1152.          ITLAC(**)=IRAT
  1153.  250  CONTINUE
  1154.       SEGSUP ITBBR1
  1155.       ITBBR1=0
  1156.       mrnouv=itlac(/1)
  1157.       GOTO 1098
  1158. C     **************************** ENTIER***************************
  1159.  6026 CONTINUE
  1160.       ITOTO=1
  1161.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1162.       IF (IRETOU.NE.0) GOTO 1000
  1163.       N    =   ILENA(1)
  1164.       M=ITLAC(/1)
  1165.       L=N
  1166.       NN=L
  1167.       SEGINI ITBBE1
  1168.       CALL LFCDEE(IORES,N,ITABE1,IRETOU,IFORM)
  1169.       IF(IRETOU.NE.0) GOTO 1000
  1170.       DO 260 I=1,L
  1171.          IVB=ITABE1(I)
  1172.          itlac(**)=ivb
  1173.  260  CONTINUE
  1174.       SEGSUP ITBBE1
  1175.       minouv=itlac(/1)
  1176.       GOTO 1098
  1177. C     **************************** MOT   ***************************
  1178.  6027 CONTINUE
  1179.       ITOTO=2
  1180.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1181.       IF (IRETOU.NE.0) GOTO 1000
  1182.       N    =   ILENA(2)
  1183.       NNN=N
  1184.       NN=ILENA(1)
  1185.       SEGINI ITAMOT
  1186.       MM=ITLAC(/1)+1
  1187.       DO 271 I=1,N
  1188.          ITLAC(**)=0
  1189.  271  CONTINUE
  1190.       CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1191.       IF(IRETOU.NE.0) GOTO 1000
  1192.       CALL LFCDIE(IORES,N,ICOTA,IRETOU,IFORM)
  1193.       IF(IRETOU.NE.0) GOTO 1000
  1194.       M=1
  1195.       DO 270 I=1,N
  1196.          LL=ICOTA(I)
  1197.          NN=ICOTA(I)-M+1
  1198.          IVA=NN
  1199.          CHA1(1:NN)=ITAMO(M:LL)
  1200.          M=LL+1
  1201.          CALL QUERAN(IRAT,'MOT     ',IVA,XVA,CHA1(1:NN),LOGI,IOB)
  1202.          if (irat.eq.0) call erreur(5)
  1203.          ITLAC(MM+I-1) =IRAT
  1204.  270  CONTINUE
  1205.       SEGSUP ITAMOT
  1206.       mmnouv=itlac(/1)
  1207.       GOTO 1098
  1208. C     ****************************TEXTE    *************************
  1209.  6028 CONTINUE
  1210.       DO 280 IEL=1,IMAX1
  1211.          ITOTO=1
  1212.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1213.          IF (IRETOU.NE.0) GOTO 1000
  1214.          N = ILENA(1)
  1215.          SEGINI MTEXTE
  1216.          NCART= N
  1217.          CALL LFCDIC(IORES,MTEXT,IRETOU,IFORM)
  1218.          SEGDES MTEXTE
  1219.          IF(IRETOU.NE.0) GOTO 1000
  1220.          ITLAC(**)=MTEXTE
  1221.  280  CONTINUE
  1222.       GOTO 1098
  1223. C     ******************************MLMOTS****************************
  1224.  6029 CONTINUE
  1225.       DO 290 IEL=1,IMAX1
  1226.          ITOTO=2
  1227.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1228.          IF (IRETOU.NE.0) GOTO 1000
  1229.          JGN = ILENA(1)
  1230.          JGM = ILENA(2)
  1231.          SEGINI MLMOTS
  1232.          NN=JGN*JGM
  1233.          NNN=0
  1234.          SEGINI ITAMOT
  1235.          CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1236.          IF(IRETOU.NE.0) GOTO 1000
  1237.          DO 56 IUH = 1,JGM
  1238.             MOTS(IUH)= ITAMO((IUH-1)*JGN+1:IUH*JGN)
  1239.  56      CONTINUE
  1240.          SEGSUP ITAMOT
  1241.          SEGDES MLMOTS
  1242.          ITLAC(**)=MLMOTS
  1243.  290  CONTINUE
  1244.       GOTO 1098
  1245. C    **************************MVECTE**********************************
  1246.  6030 CONTINUE
  1247.       DO 300 IOB=1,IMAX1
  1248.          IRETOU=0
  1249.          CALL LIVECT (MVECTE,IORES,IRETOU,IFORM)
  1250.          IF (IRETOU.NE.0) GOTO 1000
  1251.          ITLAC(**)=MVECTE
  1252.  300  CONTINUE
  1253.       GOTO 1098
  1254. C     ************************* VECTD    ***************************
  1255.  6031 CONTINUE
  1256.       DO 310 IEL=1,IMAX1
  1257.          ITOTO=1
  1258.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1259.          IF (IRETOU.NE.0) GOTO 1000
  1260.          INC  =   ILENA(1)
  1261.          SEGINI MVECTD
  1262.          CALL LFCDI2(IORES,N,VECTBB,IRETOU,IFORM)
  1263.          SEGDES MVECTD
  1264.          IF(IRETOU.NE.0) GOTO 1000
  1265.          ITLAC(**)=MVECTD
  1266.  310  CONTINUE
  1267.       GOTO 1098
  1268. C     **************************** POINTS **************************
  1269.  6032 CONTINUE
  1270.       ITOTO=1
  1271.       CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1272.       IF (IRETOU.NE.0) GOTO 1000
  1273.       N    =   ILENA(1)
  1274.       M = ITLAC(/1)
  1275.       IPLU=N-M
  1276.       DO 322 I=1,IPLU
  1277.          ITLAC(**)=0
  1278.  322  CONTINUE
  1279.       CALL LFCDIE(IORES,N,ITLAC,IRETOU,IFORM)
  1280.       IF(IRETOU.NE.0) GOTO 1000
  1281.       DO 321 I=1,N
  1282.          ITLAC(I)=ITLAC(I)+NBANC
  1283.  321  CONTINUE
  1284.       GOTO 1098
  1285. C     ****************************CONFIG   *************************
  1286.  6033 CONTINUE
  1287.       IAV=ITLAC(/1)
  1288. *      write(6,*) ' imax1 iav ' , imax1,iav
  1289.       iconul=0
  1290.       ibon=0
  1291.       DO 330 IEL=1,IMAX1
  1292.          ITOTO=1
  1293.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1294. *         write(6,*) ' lipil iel  ilena(1)' , iel , ilena(1)
  1295.          IF (IRETOU.NE.0) GOTO 1000
  1296.          ILONG=ILENA(1)
  1297. *         write(6,*) ' lipil iel  ilong' , iel , ilong
  1298.          if(ilong.eq.0) then
  1299.          iconul=iconul+1
  1300. *           nbpts=idim+1
  1301. *           segini mcoor1
  1302. *           itlac(**)=mcoor1
  1303.            GOTO 330
  1304.          endif
  1305.          IDRES=IDIM
  1306.          IDIM  = 0
  1307. *         write(6,*) ' iel ilong idres nbanc ', iel,ilong,idres,nbanc
  1308.          NBPTS = ILONG+NBANC*(IDRES+1)
  1309.          SEGINI MCOOR1
  1310.          if(ibon.eq.0) ibon=mcoor1
  1311.          IDIM=IDRES
  1312.          IDIM11= (IDIM+1)*NBANC+1
  1313.          CALL LFCDI2(IORES,ILONG,MCOOR1.XCOOR(IDIM11),IRETOU,IFORM)
  1314.          IF(IRETOU.NE.0) GOTO 1000
  1315.          DO 332 J=1,NBANC*(IDIM+1)
  1316.             MCOOR1.XCOOR(J)=XCOOR(J)
  1317.  332     CONTINUE
  1318. *         write(6,*) ' mcoor1' , mcoor1
  1319.           if (ionive.gt.26) then
  1320.            CALL LFCDIE (IORES,2,ILENA,IRETOU,IFORM)
  1321.            idimr=ilena(1)
  1322.            nbpts=ilena(2)
  1323.            if (idimr.gt.0) then
  1324.             mrotat=mcoord.mrota
  1325.             if (mrotat.eq.0) segini mrotat
  1326.             segini mrota1
  1327.             ilong=idimr*nbpts
  1328.             CALL LFCDI2(IORES,ILONG,xrota(1,nbanc+1),IRETOU,IFORM)
  1329.             DO  J=1,NBANC
  1330.             DO  i=1,idimr
  1331.               mrota1.xrota(i,j)=xrota(i,j)
  1332.             enddo
  1333.             enddo
  1334.             mcoor1.mrota=mrota1
  1335.            endif
  1336.           endif
  1337.          SEGDES MCOOR1
  1338.          ITLAC(**)=MCOOR1
  1339.  330  CONTINUE
  1340.       IF(IONIVE.GT.9) THEN
  1341.          if( iconul.ne.imax1) then
  1342.           MCOOR1=Ibon
  1343.           SEGACT MCOOR1*MOD
  1344.           SEGDES MCOORD
  1345.           MCOORD=MCOOR1
  1346.           nbpts=xcoor(/1)/(idim+1)
  1347. *         write(6,*) ' mcoord ' , mcoord
  1348.          endif
  1349.       ENDIF
  1350.       GOTO 1098
  1351. C     *************************** MLCHPO   *************************
  1352.  6034 CONTINUE
  1353.       DO 340 IEL=1,IMAX1
  1354.          ITOTO=1
  1355.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1356.          IF (IRETOU.NE.0) GOTO 1000
  1357.          N1    =   ILENA(1)
  1358.          SEGINI MLCHPO
  1359.          ITLAC(**)=MLCHPO
  1360.          CALL LFCDIE(IORES,N1,ICHPOI,IRETOU,IFORM)
  1361.          SEGDES MLCHPO
  1362.          IF(IRETOU.NE.0) GOTO 1000
  1363.  340  CONTINUE
  1364.       GOTO 1098
  1365. C     ****************************MBASEM*****************************
  1366.  6035 CONTINUE
  1367.       NN=0
  1368.       DO 3500 IEL=1,IMAX1
  1369.          ITOTO=1
  1370.          CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1371.          IF (IRETOU.NE.0) GOTO 1000
  1372.          N=ILENA(1)
  1373.          SEGINI MBASEM
  1374.          DO 3501 I=1,N
  1375.             ITOTO=1
  1376.             CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1377.             IF (IRETOU.NE.0) GOTO 1000
  1378.             NIBST=ILENA(1)
  1379.             SEGINI MSOBAS
  1380.             LISBAS(I)=MSOBAS
  1381.             CALL LFCDIE(IORES,NIBST,IBSTRM(1),IRETOU,IFORM)
  1382.             IF (IRETOU.NE.0) GOTO 1000
  1383.             SEGDES MSOBAS
  1384.  3501    CONTINUE
  1385.          SEGDES MBASEM
  1386.          ITLAC(**)=MBASEM
  1387.  3500 CONTINUE
  1388.       GOTO 1098
  1389. C     *************************** PROCED ****************************
  1390.  6036 CONTINUE
  1391. c       ========= LES PROCEDURES NE SONT PAS SAUVEES =========
  1392. c       IMAX1=NOBJN
  1393. c       SEGACT NOMM1,NOMM2
  1394. c       DO 636 IEL=1,IMAX1
  1395. c          SEGACT NOMM1,NOMM2
  1396. c          CHA1(1:8)=NOM2(IEL)
  1397. c          CHA1(9:16)=' '
  1398. c          CALL CQUOI(CHA1(1:8),CHA1(9:16),IVAL,XVA,CHARI,LOGI,IOBJ)
  1399. c          IF(IERR.EQ.0)THEN
  1400. c             ITLAC(**)= IOBJ
  1401. c          ELSE
  1402. c             IRETOU=1
  1403. c             GOTO 1000
  1404. c          ENDIF
  1405. c  636  CONTINUE
  1406.       GOTO 1097
  1407. C     *************************** BLOC   ****************************
  1408.  6037 CONTINUE
  1409.       GOTO 1097
  1410. C     *************************** MMODEL ****************************
  1411.  6038 CONTINUE
  1412.       CALL LIMODL(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC)
  1413.       IF (IRETOU.NE.0) GOTO 1000
  1414.       GOTO 1098
  1415. C     *************************** MCHAML ****************************
  1416.  6039 CONTINUE
  1417.       CALL LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
  1418.       IF (IRETOU.NE.0) GOTO 1000
  1419.       GOTO 1098
  1420. C     *************************** MINTE  ****************************
  1421.  6040 CONTINUE
  1422.       DO 2840 IEL=1,IMAX1
  1423.          ITOTO=2
  1424.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1425.          IF (IRETOU.NE.0) GOTO 1000
  1426.          NBNO   = ILENA(1)
  1427.          NBPGAU = ILENA(2)
  1428.          L=NBPGAU*4+6*NBPGAU*NBNO
  1429.          SEGINI ITBBR1
  1430.          CALL LFCDI2 (IORES,L,TABR1,IRETOU,IFORM)
  1431.          IF(IRETOU.NE.0) GOTO 1000
  1432.          SEGINI MINTE
  1433.          I=0
  1434.          DO 2841 IC=1,NBPGAU
  1435.             I=I+1
  1436.             POIGAU(IC)=TABR1(I)
  1437.             I=I+1
  1438.             QSIGAU(IC)=TABR1(I)
  1439.             I=I+1
  1440.             ETAGAU(IC)=TABR1(I)
  1441.             I=I+1
  1442.             DZEGAU(IC)=TABR1(I)
  1443.             DO 28411 IB=1,NBNO
  1444.                DO 28412 IA=1,6
  1445.                   I=I+1
  1446.                   SHPTOT(IA,IB,IC)=TABR1(I)
  1447. 28412          CONTINUE
  1448. 28411       CONTINUE
  1449.  2841    CONTINUE
  1450.          SEGSUP ITBBR1
  1451.          SEGDES MINTE
  1452.          ITLAC(**)=MINTE
  1453.  2840 CONTINUE
  1454.       GOTO 1098
  1455. C    **************************NUAGE ***************************
  1456.  6041 CALL LINUAG(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1457.       IF(IRETOU.NE.0) GOTO 1000
  1458.       GOTO 1098
  1459. C     ************************* MATRAK ********************************
  1460.  6042 CONTINUE
  1461.       CALL LIMTAK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1462.       IF (IRETOU.NE.0) GOTO 1000
  1463.       GOTO 1098
  1464. C     ************************* MATRIK ********************************
  1465.  6043 CONTINUE
  1466.       CALL LIMTIK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1467.       IF (IRETOU.NE.0) GOTO 1000
  1468.       GOTO 1098
  1469. C  **************************  METHODE *****************************
  1470.  6045 CONTINUE
  1471.       DO 6945 I=1,IMAX1
  1472.          ITLAC(**)=0
  1473.  6945 CONTINUE
  1474.       CALL LFCDIE(IORES,1,ILENA,IRETOU,IFORM)
  1475.       IF (IRETOU.NE.0) GOTO 1000
  1476.       CALL LFCDIE(IORES,IMAX1,ITLAC,IRETOU,IFORM)
  1477.       IF (IRETOU.NE.0) GOTO 1000
  1478.       GOTO 1098
  1479. C     ************************* IELVAL ********************************
  1480.  6048 CONTINUE
  1481.       CALL LIIELV(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1482.       IF (IRETOU.NE.0) GOTO 1000
  1483.       GOTO 1098
  1484. C     ************************ LISTOBJE *******************************
  1485.  6050 CONTINUE
  1486.       DO 500 IEL=1,IMAX1
  1487.          ITOTO=1
  1488.          IF (IONIVE.GT.27) ITOTO=2
  1489.          CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1490.          IF (IRETOU.NE.0) GOTO 1000
  1491.          NOBJ = ILENA(1)
  1492.          NREE = 0
  1493.          IF (ITOTO.GT.1) NREE = ILENA(2)
  1494.          SEGINI, MLOBJE
  1495.          IK = 1
  1496.          IF (NREE.GT.0) IK = 2
  1497.          ITLAC(**)=MLOBJE
  1498.          NM2 = 2
  1499.          SEGINI, ITBBM2,itbbc3
  1500.          IF (IFORM.NE.2) THEN
  1501.            CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  1502.            IF(IRETOU.NE.0) GOTO 1000
  1503.            WRITE (TYPOBJ,FMT='(2A4)') ITABM2(1),ITABM2(2)
  1504.          ELSE
  1505.            ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  1506. C          write (6,*) ' TYPOBJ itabc3 ',itabc3(1),itabc3(2)
  1507.            TYPOBJ(1:4)=itabc3(1)
  1508.            TYPOBJ(5:8)=itabc3(2)
  1509.          ENDIF
  1510.          IF (IK.EQ.1) CALL LFCDIE(IORES,NOBJ,LISOBJ,IRETOU,IFORM)
  1511.          IF (IK.EQ.2) CALL LFCDI2(IORES,NREE,RLIREE,IRETOU,IFORM)
  1512.          SEGDES, MLOBJE
  1513.          IF(IRETOU.NE.0) GOTO 1000
  1514.  500  CONTINUE
  1515.       GOTO 1098
  1516. C     ************************* IMODEL ********************************
  1517.  6051 CONTINUE
  1518.       if (niveau.lt.26) then
  1519.         write(ioimp,*) 'Pile n existant pas avant le niveau 26'
  1520.         call erreur(5)
  1521.         return
  1522.       endif
  1523.       CALL LIIMOD(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1524.       IF (IRETOU.NE.0) GOTO 1000
  1525.       GOTO 1098
  1526.  
  1527. C     ******************************************************************
  1528. C     *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
  1529. C
  1530.  1098 CONTINUE
  1531.  
  1532. C  ****  KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
  1533.       CALL CREOB (ITYPE,NOMM1,NOMM2,ITLACC,mianc,mranc,mlanc,mmanc)
  1534.       IF(IFIN.EQ.1) GOTO 1000
  1535.       GOTO 1097
  1536. ********************* ON REBOUCLE EN LECTURE **********************
  1537.  1000 CONTINUE
  1538.  1099 CONTINUE
  1539.  1001 CONTINUE
  1540.       CALL HHOPIL(6,NIVEAU,ICOLAC)
  1541.       IRET=IRETOU
  1542.       IF(NOMM1.NE.0) SEGSUP NOMM1
  1543.       IF(NOMM2.NE.0) SEGSUP NOMM2
  1544.       IF (ITBBM1.NE.0) SEGSUP ITBBM1,itbbc1
  1545.       IF (ITBBM2.NE.0) SEGSUP ITBBM2,itbbc3
  1546.       IF (ITBBE1.NE.0) SEGSUP ITBBE1
  1547.       IF (ITBBE2.NE.0) SEGSUP ITBBE2,itbbc2
  1548.       IF (ITBBR1.NE.0) SEGSUP ITBBR1
  1549.  
  1550.       SEGDES ICOLAC
  1551.  
  1552.       RETURN
  1553. C -------------------------------------------------------
  1554.  8000 FORMAT(16I5)
  1555.  8001 FORMAT(16(1X,A4))
  1556.       END
  1557.  
  1558.  
  1559.  
  1560.  
  1561.  
  1562.  
  1563.  
  1564.  
  1565.  

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