Télécharger la plaquette Cast3M


fr en

Télécharger lirefi.eso

Retour à la liste

Numérotation des lignes : 

lirefi

  1. C LIREFI    SOURCE    PV        20/03/24    21:19:00     10554          
  2. C   ROUTINE DE RELECTURE D'UN MAILLAGE SAUVE ANTERIEUREMENT
  3. C   EVENTUELLEMENT COMMUNICATION AVEC UN AUTRE PROGRAMME
  4. C   AUCUN ARGUMENT NE PARAIT NECESSAIRE
  5. C   LES OBJETS DEJA EXISTANT AYANT LE MEME NOM SERONT ECRASES
  6. C
  7.       SUBROUTINE LIREFI
  8.  
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8(A-H,O-Z)
  11.  
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC CCGEOME
  16. -INC SMELEME
  17. -INC SMCOORD
  18.  
  19.       CHARACTER*80 TEX
  20.       SEGMENT NOMCL
  21.          CHARACTER*4  CNOMCL(NBELEM)
  22.       ENDSEGMENT
  23.       SEGMENT ISGT
  24.          INTEGER ISGTR(ILONG)
  25.       ENDSEGMENT
  26.       SEGMENT CSGT
  27.          CHARACTER*8 CSGTR(ILONG)
  28.       ENDSEGMENT
  29.       SEGMENT JSGTR(ILONG)
  30.       SEGMENT ILIST(ILONG)
  31.       CHARACTER*8 ITTEMP
  32.       CHARACTER*8 ICAR
  33.       CHARACTER*4 NOMLU
  34.  
  35.       PARAMETER (NTYPRO=8)
  36.       CHARACTER*4 MOPROG(NTYPRO)
  37.       INTEGER ITYPRO
  38.  
  39.       DATA MOPROG / 'AVS ','MED ','UNV ', 'FEM ', 'PROC','CSV ','NAS ',
  40.      &              'STL '/
  41.  
  42.       ITYPRO=0
  43.  
  44. C     Recherche du mot signifiant le type de la lecture
  45.       CALL LIRMOT(MOPROG,NTYPRO,ITYPRO,0)
  46.  
  47. C     Redirection directe vers le bon type de fichier
  48.       GOTO(7001,7002,7003,7004,7005,7006,7007,7008),ITYPRO
  49. C     Si  ITYPRO=0 on va en 999
  50.       GOTO 999
  51.  
  52. C     Lecture du fichier AVS (UCD ASCII) ...
  53.  7001 CONTINUE
  54. CDEBUG         WRITE(IOIMP,3001)
  55. CDEBUG 3001    FORMAT('Lecture du fichier AVS')
  56.       CALL LIRAVS
  57.       RETURN
  58.  
  59. C     Lecture du fichier MED ...
  60.  7002 CONTINUE
  61.       CALL LIRMED
  62.       RETURN
  63.  
  64. C     Lecture du fichier UNV I-DEAS(R) ...
  65.  7003 CONTINUE
  66. CDEBUG         WRITE(IOIMP,3003)
  67. CDEBUG 3003    FORMAT('Lecture du fichier UNV')
  68.       CALL LIRUNV
  69.       RETURN
  70.  
  71. C     Lecture du fichier FEM
  72.  7004 CONTINUE
  73. CDEBUG         WRITE(IOIMP,3004)
  74. CDEBUG 3004    FORMAT('Lecture du fichier FEM')
  75.       CALL LIRFEM
  76.       RETURN
  77.  
  78. C     Lecture d'un fichier PROCEDUR
  79.  7005 CONTINUE
  80. CDEBUG         WRITE(IOIMP,3005)
  81. CDEBUG 3005    FORMAT('Lecture du fichier PROC')
  82.       CALL LIPROC
  83.       RETURN
  84.  
  85. C   Lecture d'un fichier CSV
  86.  7006 CONTINUE
  87. CDEBUG         WRITE(IOIMP,3006)
  88. CDEBUG 3006    FORMAT('Lecture du fichier CSV')
  89.       CALL LIRCSV
  90.       RETURN      
  91.  
  92. C   Lecture d'un fichier NAS
  93.  7007 CONTINUE
  94. CDEBUG         WRITE(IOIMP,3007)
  95. CDEBUG 3007    FORMAT('Lecture du fichier NAS')
  96.       CALL LIRNAS
  97.       RETURN      
  98.  
  99. C   Lecture d'un fichier STL
  100.  7008 CONTINUE
  101. CDEBUG         WRITE(IOIMP,3008)
  102. CDEBUG 3008    FORMAT('Lecture du fichier STL')
  103.       CALL LIRSTL
  104.       RETURN
  105.  
  106.  
  107.   999 CONTINUE
  108.  
  109.  
  110.  
  111.  
  112. CMB ... Ici commence l'ancienne lecture (Castem) ...
  113.  
  114.       CALL QUETYP(ICAR,0,IRET1)
  115.       IF (IERR.NE.0) RETURN
  116.       IF(IRET1.NE.0) THEN
  117.          CALL LIROBJ(ICAR,IPROUT,1,IRETOU)
  118.          IF (IERR.NE.0) RETURN
  119.       ENDIF
  120. *
  121.       READ (IOCAR,100,END=1000,ERR=1000) TEX
  122.  100  FORMAT (A80)
  123. *
  124.       IF(IRET1.NE.0) THEN
  125.          CALL QUENOM(ICAR)
  126.          MOTERR(1:8)=ICAR
  127.          IF (TEX(1:8).NE.ICAR) CALL ERREUR(9)
  128.          IF (IERR.NE.0) RETURN
  129.       ENDIF
  130. *
  131.       TITREE=TEX(1:72)
  132.       IF (IIMPI.NE.0) WRITE(IOIMP,200) TEX(1:72)
  133.  200  FORMAT (1X,A72)
  134.  
  135.       READ (IOCAR,101,END=1000,ERR=1000) IONIVE
  136.  101  FORMAT(34X,I3)
  137.       IF (IIMPI.NE.0) WRITE(IOIMP,*) 'NIVEAU ',IONIVE
  138.       IF (IONIVE.GT.2) GOTO 1000
  139.       CALL NOMENT('&NIVE',IONIVE)
  140.  
  141.       READ(IOCAR,102,END=1000,ERR=1000) IaRR,JDIM,DENSIT
  142.  102  FORMAT(6X,I4,10X,I4,9X,E12.5)
  143.  
  144.       IF (IIMPI.NE.0) WRITE (IOIMP,201) IaRR,JDIM,DENSIT
  145.  201  FORMAT (1X,'ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',1PE12.5)
  146.       IERMAX=MAX(IERMAX,IaRR)
  147. *      IERR=0
  148.       CALL GINT2
  149.       IF (IDIM.EQ.0) IDIM=JDIM
  150.       IF (JDIM.NE.IDIM) CALL ERREUR(12)
  151.       CALL NOMENT('&DIME',IDIM)
  152.  
  153.       READ (IOCAR,103,END=1000,ERR=1000) INOMB
  154.  103  FORMAT(17X,I8)
  155.       IF (IIMPI.NE.0) WRITE (IOIMP,202) INOMB
  156.  202  FORMAT(' NOMBRE DE POINTS A LIRE ',I8)
  157.       SEGACT MCOORD*mod
  158.       NBANC=nbpts
  159.       NBNOUV=NBANC+INOMB
  160.       NBPTS=NBNOUV
  161.       SEGADJ MCOORD
  162.       NDEBB=NBANC+1
  163.       NBC=IDIM+1
  164.       READ (IOCAR,104,ERR=1000,END=1000) ((XCOOR((J-1)*(IDIM+1)+I),I=1,
  165.      #  NBC),J=NDEBB,NBNOUV)
  166.  104  FORMAT (6E12.5)
  167.  
  168. C  LECTURE DES POINTS NOMMES
  169.       READ (IOCAR,105,END=1000,ERR=1000) ILONG
  170.  105  FORMAT(23X,I8)
  171.       IF (ILONG.NE.0) THEN
  172.          SEGINI ISGT,CSGT
  173.          READ (IOCAR,106,END=1000,ERR=1000)(CSGTR(I),ISGTR(I),I=1,ILONG)
  174.  106     FORMAT(5(A8,I8))
  175.          IF (IIMPI.NE.0) WRITE (IOIMP,203)(CSGTR(I),ISGTR(I),I=1,ILONG)
  176.  203     FORMAT(' LISTE DES POINTS NOMMES',/,5(1X,A8,I8))
  177.          DO 5 I=1,ILONG
  178.             ITTEMP=CSGTR(I)
  179.             ITVAL=ISGTR(I)+NBANC
  180.             CALL NOMOBJ('POINT',ITTEMP,ITVAL)
  181.    5     CONTINUE
  182.          SEGSUP ISGT,CSGT
  183.       ENDIF
  184.  
  185. C  LECTURE DES OBJETS
  186.       READ (IOCAR,116,END=1000,ERR=1000) ILONG
  187.  116  FORMAT (16X,I8)
  188.  
  189.       IF (IIMPI.NE.0) WRITE (IOIMP,204) ILONG
  190.  204  FORMAT (' NOMBRE D''OBJETS',I8)
  191.  
  192.       SEGINI JSGTR
  193.       DO 7 IOB=1,ILONG
  194.          IF (IONIVE.LE.1) THEN
  195.             READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  196.      +                                         NBNN,NBELEM
  197.  107        FORMAT(A4,12X,I4,11X,I4,10X,I4,8X,I4)
  198.          ELSE
  199.             READ (IOCAR,1107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  200.      +                                          NBNN,NBELEM
  201. 1107        FORMAT(A4,12X,I4,11X,I4,10X,I4,7X,I5)
  202.          ENDIF
  203.          IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM
  204.  205  FORMAT(' NOMLU ',A4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM
  205.      # ',I4)
  206.  
  207.          SEGINI MELEME
  208.          JSGTR(IOB)=MELEME
  209.          IF (NBSOUS.NE.0)
  210.      +      READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS)
  211.  108        FORMAT(20I4)
  212.  
  213.          IF (NBREF.NE.0)
  214.      +      READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF)
  215.  
  216.          IF (NBELEM.EQ.0) GOTO 7
  217.  
  218. C ... EST CE UN TYPE D'ELEM CONNU
  219.          DO 10 I=1,NOMBR
  220.             IF (NOMLU.EQ.NOMS(I)) GOTO 11
  221.   10     CONTINUE
  222.          SEGSUP MELEME,JSGTR
  223.          RETURN
  224.   11     ITYPEL=I
  225.          IF( IONIVE .EQ. 0 ) THEN
  226.             DO 1800 I = 1,NBELEM
  227.                ICOLOR(I)=IDCOUL
  228.  1800       CONTINUE
  229.          ELSE
  230.             SEGINI NOMCL
  231.             READ (IOCAR,112,END=1000,ERR=1000)(CNOMCL(I),I=1,NBELEM)
  232.  112        FORMAT (16(1X,A4))
  233.             DO 18 I=1,NBELEM
  234.                IREP=IDCOUL
  235.                DO 19 J=0,NBCOUL
  236.                   IF (CNOMCL(I).EQ.NCOUL(J)) IREP=J
  237. 19             CONTINUE
  238.                   ICOLOR(I)=IREP
  239. 18          CONTINUE
  240.             SEGSUP NOMCL
  241.          ENDIF
  242.          READ (IOCAR,111,END=1000,ERR=1000)((NUM(I,J),I=1,NBNN),
  243.      +                                               J=1,NBELEM)
  244.  111     FORMAT (16I5)
  245.    7  CONTINUE
  246.  
  247.       DO 12 I=1,ILONG
  248.          MELEME=JSGTR(I)
  249.          IF (LISOUS(/1).NE.0) THEN
  250.             DO 14 J=1,LISOUS(/1)
  251.                LISOUS(J)=JSGTR(LISOUS(J))
  252.   14        CONTINUE
  253.          ENDIF
  254.          IF (LISREF(/1).NE.0) THEN
  255.             DO 16 J=1,LISREF(/1)
  256.                LISREF(J)=JSGTR(LISREF(J))
  257.   16        CONTINUE
  258.          ENDIF
  259.          DO 17 IK=1,NUM(/1)
  260.             DO 17 JK=1,NUM(/2)
  261.                NUM(IK,JK)=NUM(IK,JK)+NBANC
  262.   17     CONTINUE
  263.          SEGDES MELEME
  264.   12  CONTINUE
  265.  
  266.       READ (IOCAR,109,ERR=1000,END=1000) INN
  267.  109  FORMAT(22X,I8)
  268.  
  269.       ILONG=3*INN
  270.       SEGINI ILIST
  271.       READ (IOCAR,110,END=1000,ERR=1000)(ILIST(I),I=1,ILONG)
  272.  110  FORMAT(5(2A4,I8))
  273.  
  274.       IF (IIMPI.NE.0) WRITE (IOIMP,206) (ILIST(I),I=1,ILONG)
  275.  206  FORMAT (' LISTE DES OBJETS NOMMES',/,5(1X,2A4,I8))
  276.  
  277.       DO 25 I=1,ILONG,3
  278.          WRITE(ITTEMP,FMT='(2A4)')ILIST(I),ILIST(I+1)
  279.          ITVAL=JSGTR(ILIST(I+2))
  280.          CALL NOMOBJ('MAILLAGE',ITTEMP,ITVAL)
  281.   25  CONTINUE
  282.       SEGSUP JSGTR,ILIST
  283. C
  284. C **** LECTURE DU FICHIER TTMF
  285. C
  286.       READ(IOCAR,1002,END=1001) IQUOI
  287.  1002 FORMAT(7X,I5)
  288.  
  289.       CALL RESTSO(IQUOI,NBANC)
  290.  1001 CONTINUE
  291.       RETURN
  292.  
  293.  1000 CONTINUE
  294.       CALL ERREUR(26)
  295.       RETURN
  296.       END
  297.  
  298.  
  299.  
  300.  

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