Télécharger la plaquette Cast3M


fr en

Télécharger liravs.eso

Retour à la liste

Numérotation des lignes : 

liravs

  1. C LIRAVS    SOURCE    FANDEUR   22/01/12    21:15:02     11265          
  2.  
  3.       SUBROUTINE LIRAVS
  4.  
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C BUT: Lecture des données provenant de AVS sous forme de
  8. C      fichier UCD (Unstructured Cell Data) ASCII. Les données
  9. C      sont logées dans une table qui est renvoyée comme
  10. C      résultat.
  11. C
  12. C Auteur : Michel Bulik
  13. C          Septembre 1994
  14. C
  15. C Appelé par : LIREFI
  16. C
  17. C FA7902     Modifications ordre des noeuds pour TE10
  18. C (2014/01)  Ajout lecture commentaires entete du fichier
  19. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  20.  
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC CCREDLE
  27.  
  28. -INC SMCOORD
  29. -INC SMELEME
  30. -INC SMTABLE
  31. -INC SMCHAML
  32. -INC SMCHPOI
  33.  
  34. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  35.  
  36.       SEGMENT LISTMA
  37.          POINTEUR PTMA(NBSZEL).MELEME
  38.          INTEGER  MATER(NBSZEL)
  39.          INTEGER  TYPDEL(NBSZEL)
  40.          INTEGER  NUMEMA(NOMBEL)
  41.          INTEGER  NUMELE(NOMBEL)
  42.       ENDSEGMENT
  43.  
  44. C
  45. C   Description du segment LISTMA (LISTe des MAillages)
  46. C
  47. C   Paramètres :   NBSZEL - NomBre de Sous Zones ELémentaires
  48. C                  NOMBEL - NOMBre total des ELéments
  49. C
  50. C   Tableaux   :   PTMA   - PoinTeurs sur des MAillages élémentaires
  51. C                  MATER  - numéros des MATERiaux des sous-zones
  52. C                  TYPDEL - TYPes Des ELéments des sous-zones (=ITYPEL)
  53. C                  NUMEMA - NUMEros des MAillages auquels appartiennent
  54. C                           les éléments (1..NBSZEL)
  55. C                  NUMELE - le NUMéro de l'ELEment dans sa sous zone
  56. C
  57. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  58.  
  59. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  60.  
  61.       SEGMENT LISTCO
  62.          CHARACTER*(LOCOMP)  LESNOM(NBCOMP)
  63.          REAL*8              LESCOM(NBDELE,NBCOMP)
  64.       ENDSEGMENT
  65.  
  66. C
  67. C   Description du segment LISTCO (LISTe des COmposantes du MCHAML)
  68. C
  69. C   Paramètres : NBCOMP - le NomBre des COMPosantes
  70. C                NBDELE - le NomBre D'ELEments
  71. C
  72. C   Tableaux   : LESNOM - LES NOMs des composantes
  73. C                LESCOM - LES COMposantes elles memes
  74. C
  75. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  76.  
  77. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  78.  
  79.       SEGMENT LISGRC
  80.          INTEGER  LESGRC(NBGRCO)
  81.       ENDSEGMENT
  82.  
  83. C
  84. C   Description du segment LISGRC (LISTe des GRoupes de Composantes)
  85. C
  86. C   Paramètres : NBGRCO - le NomBre de GRoupes de COmposantes
  87. C
  88. C   Tableaux   : LESGRC - LES GRoupes des Composantes
  89. C
  90. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  91.  
  92.       CHARACTER*8   MTYPEL
  93. C ... Tableau où on stocke temporairement les connectivités lues ...
  94.       INTEGER       ICONNT(20)
  95.  
  96. C ... Conversion MAJUSCULE/minuscule
  97.       CHARACTER*26 MINU,MAJU
  98.  
  99. C ... Tableaux de conversion de connectivités (IC<nom_élément>) ...
  100.       DIMENSION ICPOI1( 1)
  101.       DIMENSION ICSEG2( 2)
  102.       DIMENSION ICSEG3( 3)
  103.       DIMENSION ICTRI3( 3)
  104.       DIMENSION ICTRI6( 6)
  105.       DIMENSION ICQUA4( 4)
  106.       DIMENSION ICQUA8( 8)
  107.       DIMENSION ICCUB8( 8)
  108.       DIMENSION ICCU20(20)
  109.       DIMENSION ICPRI6( 6)
  110.       DIMENSION ICPR15(15)
  111.       DIMENSION ICTET4( 4)
  112.       DIMENSION ICTE10(10)
  113.       DIMENSION ICPYR5( 5)
  114.       DIMENSION ICPY13(13)
  115.  
  116.       DATA ICPOI1 / 1/
  117.       DATA ICSEG2 / 1, 2/
  118.       DATA ICSEG3 / 1, 3, 2/
  119.       DATA ICTRI3 / 1, 2, 3/
  120.       DATA ICTRI6 / 1, 4, 2, 5, 3, 6/
  121.       DATA ICQUA4 / 1, 2, 3, 4/
  122.       DATA ICQUA8 / 1, 5, 2, 6, 3, 7, 4, 8/
  123.       DATA ICCUB8 / 1, 2, 3, 4, 5, 6, 7, 8/
  124.       DATA ICCU20 / 1, 9, 2,10, 3,11, 4,12,17,18,
  125.      &             19,20, 5,13, 6,14, 7,15, 8,16/
  126.       DATA ICPRI6 / 1, 2, 3, 4, 5, 6/
  127.       DATA ICPR15 / 1, 7, 2, 8, 3, 9,14,13,15, 4,
  128.      &             10, 5,11, 6,12/
  129.       DATA ICTET4 / 1, 2, 3, 4/
  130.       DATA ICTE10 / 1, 5, 2, 8, 3, 6, 7,10, 9, 4/
  131.       DATA ICPYR5 / 2, 3, 4, 5, 1/
  132.       DATA ICPY13 / 2,10, 3,11, 4,12, 5,13, 6, 7,
  133.      &              8, 9, 1/
  134.  
  135.       DATA MINU / 'abcdefghijklmnopqrstuvwxyz' /
  136.       DATA MAJU / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
  137.  
  138. C ... Sauvetage de la lecture ...
  139.       call inired(sredle)
  140.  
  141. C* Dans le cas ou la dimension n'est pas connue (IDIM=0), il faudrait 
  142. C* qu'elle le soit a la lecture du fichier selon les coordonnees lues !
  143. C* Voir par exemple ce qui est fait dans LIRUNV.eso !
  144.       IF(IDIM.EQ.0) IDIM=3
  145.       LISTMA=0
  146.  
  147. C ... Création de la table de sortie ...
  148.       CALL CRTABL(MTABLE)
  149.  
  150. C ... Lecture de la première ligne ...
  151.  9010 CONTINUE
  152.       READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  153. C ... On saute les lignes de commentaires qui n'existent qu'en entete ...
  154.       IF (TEXT(1:1).EQ.'#') GOTO 9010
  155.  3000 FORMAT(A256)
  156. CNONF77      READ(LIGNE,*,ERR=9999) NBNPTS,NBELTS,NBCONO,NBCOEL,NBCOGL
  157.       NRAN=0
  158.       ICOUR=256
  159.       IFINAN=257
  160.       CALL REDLEC(sredle)
  161.       IF(IRE.EQ.1) THEN
  162.          NBNPTS=NFIX
  163.       ELSE
  164.          GOTO 9999
  165.       ENDIF
  166.  
  167.       CALL REDLEC(sredle)
  168.       IF(IRE.EQ.1) THEN
  169.          NBELTS=NFIX
  170.       ELSE
  171.          GOTO 9999
  172.       ENDIF
  173.  
  174.       CALL REDLEC(sredle)
  175.       IF(IRE.EQ.1) THEN
  176.          NBCONO=NFIX
  177.       ELSE
  178.          GOTO 9999
  179.       ENDIF
  180.  
  181.       CALL REDLEC(sredle)
  182.       IF(IRE.EQ.1) THEN
  183.          NBCOEL=NFIX
  184.       ELSE
  185.          GOTO 9999
  186.       ENDIF
  187.  
  188.       CALL REDLEC(sredle)
  189.       IF(IRE.EQ.1) THEN
  190.          NBCOGL=NFIX
  191.       ELSE
  192.          GOTO 9999
  193.       ENDIF
  194.  
  195. CDEBUG      write(ioimp,*) 'NBNPTS = ',NBNPTS
  196. CDEBUG      write(ioimp,*) 'NBELTS = ',NBELTS
  197. CDEBUG      write(ioimp,*) 'NBCONO = ',NBCONO
  198. CDEBUG      write(ioimp,*) 'NBCOEL = ',NBCOEL
  199.  
  200. C ... Lecture des coordonnées ...
  201.       SEGACT MCOORD*mod
  202.       NBANC=nbpts
  203.       NBNOUV=NBANC+NBNPTS
  204.       NBPTS=NBNOUV
  205.       SEGADJ MCOORD
  206.       NDEBB=NBANC+1
  207.       NBC=IDIM+1
  208.       DO 3020 J=NDEBB,NBNOUV
  209.          READ (IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  210.          IF (TEXT(1:1).EQ.'#') GOTO 9999
  211. CMB  ... AVS donne toujours 3 coordonnées ...
  212. CNONF77         READ (LIGNE,*,ERR=9999) IKK,(XCOOR((J-1)*NBC+I),I=1,3)
  213.          NRAN=0
  214.          ICOUR=256
  215.          IFINAN=257
  216.          CALL REDLEC(sredle)
  217.          IF(IRE.EQ.1) THEN
  218.             IKK=NFIX
  219.          ELSE
  220.             GOTO 9999
  221.          ENDIF
  222. c* On suppose que J = NBANC + IKK !
  223.          NUMNO = (J-1) * NBC
  224. C ... On ne lit que IDIM coordonnees (et non systematiquement 3 !)
  225.          DO 3015 I=1,IDIM
  226.             CALL REDLEC(sredle)
  227.             IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  228.                XCOOR(NUMNO+I)=FLOT
  229.             ELSE
  230.                GOTO 9999
  231.             ENDIF
  232.  3015    CONTINUE
  233. C    ... On met la densite a 0
  234.          XCOOR(NUMNO+NBC)=0.D0
  235.  3020 CONTINUE
  236.  
  237. CDEBUG      write(ioimp,*) 'Lecture des noeuds terminée'
  238.  
  239. C ... Préparation du support des champs de vitesses (composé des POI1) ...
  240.       IPT2=0
  241.       NBELEM=NBNPTS
  242.       NBNN=1
  243.       NBSOUS=0
  244.       NBREF=0
  245.       SEGINI IPT2
  246.       IPT2.ITYPEL=1
  247.       DO 3025 I=NBANC+1,NBANC+NBNPTS
  248.          IPT2.NUM(1,I-NBANC)=I
  249. c*         IPT2.ICOLOR(I-NBANC)=0
  250.  3025 CONTINUE
  251.       CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,'MAILSUPP',.FALSE.,0,
  252.      &                   'MAILLAGE',0,0.d0,'        ',.FALSE.,IPT2)
  253.       SEGDES IPT2
  254.  
  255. CDEBUG      write(ioimp,*) 'Préparation du support du CHPOINT terminée'
  256.  
  257. C ... Lecture du maillage ...
  258.       NBSZEL=0
  259.       NOMBEL=NBELTS
  260.       SEGINI LISTMA
  261.  
  262.       DO 3030 I=1,NBELTS
  263.          READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  264.          IF (TEXT(1:1).EQ.'#') GOTO 9999
  265. CNONF77         READ(LIGNE,*,ERR=9999) INUMEL,INUMAT,MTYPEL
  266.          NRAN=0
  267.          ICOUR=256
  268.          IFINAN=257
  269.          CALL REDLEC(sredle)
  270.          IF(IRE.EQ.1) THEN
  271.             INUMEL=NFIX
  272.          ELSE
  273.             GOTO 9999
  274.          ENDIF
  275.  
  276.          CALL REDLEC(sredle)
  277.          IF(IRE.EQ.1) THEN
  278.             INUMAT=NFIX
  279.          ELSE
  280.             GOTO 9999
  281.          ENDIF
  282.  
  283.          CALL REDLEC(sredle)
  284.          IF(IRE.EQ.3) THEN
  285.             DO 3031 IAUX=1, NCAR
  286.               IRAL=INDEX(MAJU,MOT(IAUX:IAUX))
  287.               IF (IRAL.NE.0) MOT(IAUX:IAUX)=MINU(IRAL:IRAL)
  288.  3031       CONTINUE
  289.             MTYPEL=MOT(1:NCAR)
  290.          ELSE
  291.             GOTO 9999
  292.          ENDIF
  293.  
  294.          IF     (MTYPEL.EQ.'pt      ') THEN
  295.  
  296. CNONF77            READ(LIGNE,*,END=9999) INUMEL,INUMAT,MTYPEL,
  297. CNONF77     &                              ICONNT(1)
  298.             CALL REDLEC(sredle)
  299.             IF(IRE.EQ.1) THEN
  300.                ICONNT(1)=NFIX
  301.             ELSE
  302.                GOTO 9999
  303.             ENDIF
  304.  
  305.             ITELAC=1
  306.             CALL EMPELE(I,ITELAC,INUMAT,ICPOI1,LISTMA,ICONNT)
  307.             GOTO 3030
  308.  
  309.          ELSE IF(MTYPEL.EQ.'line    ') THEN
  310.  
  311. CNONF77            READ(LIGNE,*,END=5299) INUMEL,INUMAT,MTYPEL,
  312. CNONF77     &                             (ICONNT(J),J=1,3)
  313.  
  314.             NBENT=0
  315.             DO 5250 J=1,3
  316.                CALL REDLEC(sredle)
  317.                IF(IRE.EQ.1) THEN
  318.                   ICONNT(J)=NFIX
  319.                ELSE
  320.                   GOTO 5299
  321.                ENDIF
  322.                NBENT=J
  323.  5250       CONTINUE
  324.  
  325. C       ... C'est un SEG3 ...
  326.             ITELAC=3
  327.             CALL EMPELE(I,ITELAC,INUMAT,ICSEG3,LISTMA,ICONNT)
  328.             GOTO 3030
  329. C       ... C'est un SEG2 ...
  330.  5299       IF(NBENT.NE.2) GOTO 9999
  331.             ITELAC=2
  332.             CALL EMPELE(I,ITELAC,INUMAT,ICSEG2,LISTMA,ICONNT)
  333.             GOTO 3030
  334.  
  335.          ELSE IF(MTYPEL.EQ.'tri     ') THEN
  336.  
  337. CNONF77            READ(LIGNE,*,END=5399) INUMEL,INUMAT,MTYPEL,
  338. CNONF77     &                             (ICONNT(J),J=1,6)
  339.  
  340.             NBENT=0
  341.             DO 5350 J=1,6
  342.                CALL REDLEC(sredle)
  343.                IF(IRE.EQ.1) THEN
  344.                   ICONNT(J)=NFIX
  345.                ELSE
  346.                   GOTO 5399
  347.                ENDIF
  348.                NBENT=J
  349.  5350       CONTINUE
  350.  
  351. C       ... C'est un TRI6 ...
  352.             ITELAC=6
  353.             CALL EMPELE(I,ITELAC,INUMAT,ICTRI6,LISTMA,ICONNT)
  354.             GOTO 3030
  355. C       ... C'est un TRI3 ...
  356.  5399       IF(NBENT.NE.3) GOTO 9999
  357.             ITELAC=4
  358.             CALL EMPELE(I,ITELAC,INUMAT,ICTRI3,LISTMA,ICONNT)
  359.             GOTO 3030
  360.  
  361.          ELSE IF(MTYPEL.EQ.'quad    ') THEN
  362.  
  363. CNONF77            READ(LIGNE,*,END=5499) INUMEL,INUMAT,MTYPEL,
  364. CNONF77     &                             (ICONNT(J),J=1,8)
  365.  
  366.             NBENT=0
  367.             DO 5450 J=1,8
  368.                CALL REDLEC(sredle)
  369.                IF(IRE.EQ.1) THEN
  370.                   ICONNT(J)=NFIX
  371.                ELSE
  372.                   GOTO 5499
  373.                ENDIF
  374.                NBENT=J
  375.  5450       CONTINUE
  376.  
  377. C       ... C'est un QUA8 ...
  378.             ITELAC=10
  379.             CALL EMPELE(I,ITELAC,INUMAT,ICQUA8,LISTMA,ICONNT)
  380.             GOTO 3030
  381. C       ... C'est un QUA4 ...
  382.  5499       IF(NBENT.NE.4) GOTO 9999
  383.             ITELAC=8
  384.             CALL EMPELE(I,ITELAC,INUMAT,ICQUA4,LISTMA,ICONNT)
  385.             GOTO 3030
  386.  
  387.          ELSE IF(MTYPEL.EQ.'tet     ') THEN
  388.  
  389. CNONF77            READ(LIGNE,*,END=5599) INUMEL,INUMAT,MTYPEL,
  390. CNONF77     &                             (ICONNT(J),J=1,10)
  391.  
  392.             NBENT=0
  393.             DO 5550 J=1,10
  394.                CALL REDLEC(sredle)
  395.                IF(IRE.EQ.1) THEN
  396.                   ICONNT(J)=NFIX
  397.                ELSE
  398.                   GOTO 5599
  399.                ENDIF
  400.                NBENT=J
  401.  5550       CONTINUE
  402.  
  403. C       ... C'est un TE10 ...
  404.             ITELAC=24
  405.             CALL EMPELE(I,ITELAC,INUMAT,ICTE10,LISTMA,ICONNT)
  406.             GOTO 3030
  407. C       ... C'est un TET4 ...
  408.  5599       IF(NBENT.NE.4) GOTO 9999
  409.             ITELAC=23
  410.             CALL EMPELE(I,ITELAC,INUMAT,ICTET4,LISTMA,ICONNT)
  411.             GOTO 3030
  412.  
  413.          ELSE IF(MTYPEL.EQ.'pyr     ') THEN
  414.  
  415. CNONF77            READ(LIGNE,*,END=5699) INUMEL,INUMAT,MTYPEL,
  416. CNONF77     &                             (ICONNT(J),J=1,13)
  417.  
  418.             NBENT=0
  419.             DO 5650 J=1,13
  420.                CALL REDLEC(sredle)
  421.                IF(IRE.EQ.1) THEN
  422.                   ICONNT(J)=NFIX
  423.                ELSE
  424.                   GOTO 5699
  425.                ENDIF
  426.                NBENT=J
  427.  5650       CONTINUE
  428.  
  429. C       ... C'est un PY13 ...
  430.             ITELAC=26
  431.             CALL EMPELE(I,ITELAC,INUMAT,ICPY13,LISTMA,ICONNT)
  432.             GOTO 3030
  433. C       ... C'est un PYR5 ...
  434.  5699       IF(NBENT.NE.5) GOTO 9999
  435.             ITELAC=25
  436.             CALL EMPELE(I,ITELAC,INUMAT,ICPYR5,LISTMA,ICONNT)
  437.             GOTO 3030
  438.  
  439.          ELSE IF(MTYPEL.EQ.'prism   ') THEN
  440.  
  441. CNONF77            READ(LIGNE,*,END=5799) INUMEL,INUMAT,MTYPEL,
  442. CNONF77     &                             (ICONNT(J),J=1,15)
  443.  
  444.             NBENT=0
  445.             DO 5750 J=1,15
  446.                CALL REDLEC(sredle)
  447.                IF(IRE.EQ.1) THEN
  448.                   ICONNT(J)=NFIX
  449.                ELSE
  450.                   GOTO 5799
  451.                ENDIF
  452.                NBENT=J
  453.  5750       CONTINUE
  454.  
  455. C       ... C'est un PR15 ...
  456.             ITELAC=17
  457.             CALL EMPELE(I,ITELAC,INUMAT,ICPR15,LISTMA,ICONNT)
  458.             GOTO 3030
  459. C       ... C'est un PRI6 ...
  460.  5799       IF(NBENT.NE.6) GOTO 9999
  461.             ITELAC=16
  462.             CALL EMPELE(I,ITELAC,INUMAT,ICPRI6,LISTMA,ICONNT)
  463.             GOTO 3030
  464.  
  465.          ELSE IF(MTYPEL.EQ.'hex     ') THEN
  466.  
  467. CNONF77            READ(LIGNE,*,END=5899) INUMEL,INUMAT,MTYPEL,
  468. CNONF77     &                             (ICONNT(J),J=1,20)
  469.  
  470.             NBENT=0
  471.             DO 5850 J=1,20
  472.                CALL REDLEC(sredle)
  473.                IF(IRE.EQ.1) THEN
  474.                   ICONNT(J)=NFIX
  475.                ELSE
  476.                   GOTO 5899
  477.                ENDIF
  478.                NBENT=J
  479.  5850       CONTINUE
  480.  
  481. C       ... C'est un CU20 ...
  482.             ITELAC=15
  483.             CALL EMPELE(I,ITELAC,INUMAT,ICCU20,LISTMA,ICONNT)
  484.             GOTO 3030
  485. C       ... C'est un CUB8 ...
  486.  5899       IF(NBENT.NE.8) GOTO 9999
  487.             ITELAC=14
  488.             CALL EMPELE(I,ITELAC,INUMAT,ICCUB8,LISTMA,ICONNT)
  489.             GOTO 3030
  490.  
  491.          ELSE
  492.  
  493.             MOTERR(1:8)=MTYPEL
  494.             CALL ERREUR(702)
  495.             GOTO 9000
  496.  
  497.          ENDIF
  498.  3030 CONTINUE
  499.  
  500.       NBSZEL = LISTMA.MATER(/1)
  501.  
  502. CDEBUG      WRITE(IOIMP,*) 'Maillage lu'
  503. CDEBUG      WRITE(IOIMP,*) '   NBSZEL = ',NBSZEL
  504.  
  505. C ... On décale les connectivités ...
  506.       DO 3035 K=1,NBSZEL
  507.          IPT5=LISTMA.PTMA(K)
  508.          SEGACT IPT5*MOD
  509.          NBNN=IPT5.NUM(/1)
  510.          NBELEM=IPT5.NUM(/2)
  511.          DO I=1,NBNN
  512.             DO J=1,NBELEM
  513.                IPT5.NUM(I,J)=IPT5.NUM(I,J)+NBANC
  514.             ENDDO
  515.          ENDDO
  516.          SEGDES IPT5
  517.  3035 CONTINUE
  518.  
  519. CDEBUG      WRITE(IOIMP,*) 'Connectivités décalées'
  520.  
  521. C ... Création du chapeau des sous-maillages ...
  522.       IF (NBSZEL.EQ.1) THEN
  523.         MELEME = LISTMA.PTMA(1)
  524.       ELSE
  525.         MELEME=0
  526.         NBELEM=0
  527.         NBNN=0
  528.         NBSOUS=NBSZEL
  529.         NBREF=1
  530.         SEGINI MELEME
  531.         ITYPEL=0
  532.         LISREF(1)=IPT2
  533.         DO 3032 I=1,NBSZEL
  534.            LISOUS(I)=LISTMA.PTMA(I)
  535.  3032   CONTINUE
  536.         SEGDES MELEME
  537.       ENDIF
  538.  
  539. CDEBUG      WRITE(IOIMP,*) 'Chapeau des maillages créé'
  540.  
  541.       CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,'LEMAILLA',.FALSE.,0,
  542.      &                   'MAILLAGE',0,0.d0,'        ',.FALSE.,MELEME)
  543.  
  544. C ... On met les sous maillages dans une sous table indicée par leur numéros ...
  545.       CALL CRTABL(MTAB1)
  546.       CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,'SOUMAILA',.FALSE.,0,
  547.      &                   'TABLE   ',0,0.d0,'        ',.FALSE.,MTAB1)
  548.       DO 3033 I=1,NBSZEL
  549.          IPT8=LISTMA.PTMA(I)
  550.          CALL ECCTAB(MTAB1,'ENTIER  ',I,0.d0,'        ',.FALSE.,0,
  551.      &                     'MAILLAGE',0,0.d0,'        ',.FALSE.,IPT8)
  552.  3033 CONTINUE
  553.  
  554. CDEBUG      WRITE(IOIMP,*) 'Maillages mis dans la table'
  555.  
  556. C ... Lecture du CHPOINT ...
  557.  
  558.       IF(NBCONO.GT.0) THEN
  559.          READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  560.          IF (TEXT(1:1).EQ.'#') GOTO 9999
  561. CNONF77         READ(LIGNE,*,ERR=9999) NBGRCO
  562.          NRAN=0
  563.          ICOUR=256
  564.          IFINAN=257
  565.          CALL REDLEC(sredle)
  566.          IF(IRE.EQ.1) THEN
  567.             NBGRCO=NFIX
  568.          ELSE
  569.             GOTO 9999
  570.          ENDIF
  571.          SEGINI LISGRC
  572.  
  573. CNONF77         READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  574.          DO 3034 I=1,NBGRCO
  575.             CALL REDLEC(sredle)
  576.             IF(IRE.EQ.1) THEN
  577.                LESGRC(I)=NFIX
  578.             ELSE
  579.                GOTO 9999
  580.             ENDIF
  581.  3034    CONTINUE
  582.  
  583. CDEBUG         write(IOIMP,*) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  584.  
  585.          NAT=1
  586.          NSOUPO=1
  587.          MCHPOI=0
  588.          SEGINI MCHPOI
  589.          MTYPOI='        '
  590.          MOCHDE='                                    '
  591.      &        //'                                    '
  592.          JATTRI(1)=1
  593.          IFOPOI=IFOUR
  594.          NC=NBCONO
  595.          SEGINI MSOUPO
  596.          IPCHP(1)=MSOUPO
  597.          K = 0
  598.          DO 3079 I=1,NBGRCO
  599.             READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  600.             IF (TEXT(1:1).EQ.'#') GOTO 9999
  601.             DO 3077 J=1,LESGRC(I)
  602.                K = K + 1
  603. CNONF77               READ(LIGNE,*,END=3076) NOCOMP(K)
  604. CNONF77 3076          CONTINUE
  605.                NRAN=0
  606.                ICOUR=256
  607.                IFINAN=257
  608.                CALL REDLEC(sredle)
  609.                IF(IRE.EQ.3) THEN
  610.                   NOCOMP(K)=MOT(1:NCAR)
  611. CDEBUG      write(ioimp,*) 'Composante N° ',J,' = ',NOCOMP(K)
  612.                ELSE
  613.                   GOTO 9999
  614.                ENDIF
  615. C          ... Attention à la virgule qui n'est pas considérée comme un
  616. C              séparateur par REDLEC ...
  617.                DO 3075 INUMC=1,4
  618.                   IF(NOCOMP(K)(INUMC:INUMC).EQ.',') THEN
  619.                      NOCOMP(K)(INUMC:4)=' '
  620.                      GOTO 3076
  621.                   ENDIF
  622.  3075          CONTINUE
  623.  3076          CONTINUE
  624.                IF(LESGRC(I).GT.1) THEN
  625.                   IKK=LEN(NOCOMP(K))
  626.                   CALL AJNUME(NOCOMP(K),IKK,J)
  627.                ENDIF
  628.  3077       CONTINUE
  629. C       ... Attention !!! Les noms des composantes des champs scalaires risquent de ne pas etre uniques
  630. C           si la différence se trouve au délà du 4ème caractère !!! ...
  631.  3079    CONTINUE
  632.          SEGSUP LISGRC
  633.          IGEOC=IPT2
  634.          DO 3080 I=1,NC
  635.             NOHARM(I)=0
  636.  3080    CONTINUE
  637.          N=NBNPTS
  638.          SEGINI MPOVAL
  639.          IPOVAL=MPOVAL
  640.          DO 3090 I=1,N
  641.             READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  642.             IF (TEXT(1:1).EQ.'#') GOTO 9999
  643. CDEBUG      write(ioimp,*) 'Ligne avec les composantes N°',I,' lue'
  644. CNONF77            READ(LIGNE,*,ERR=9999) IKK,(VPOCHA(I,J),J=1,NC)
  645.             NRAN=0
  646.             ICOUR=256
  647.             IFINAN=257
  648.             CALL REDLEC(sredle)
  649.             IF(IRE.EQ.1) THEN
  650.                IKK=NFIX
  651.             ELSE
  652.                GOTO 9999
  653.             ENDIF
  654.             DO 30901 J=1,NC
  655.                CALL REDLEC(sredle)
  656.                IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  657.                   VPOCHA(I,J)=FLOT
  658.                ELSE
  659.                   GOTO 9999
  660.                ENDIF
  661. 30901       CONTINUE
  662.  3090    CONTINUE
  663.          CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,'LECHPOIN',.FALSE.,0,
  664.      &                      'CHPOINT ',0,0.d0,'        ',.FALSE.,MCHPOI)
  665.          SEGDES MPOVAL
  666.          SEGDES MSOUPO
  667.          SEGDES MCHPOI
  668.       ENDIF
  669.  
  670. CDEBUG      WRITE(IOIMP,*) 'CHPOINT lu'
  671.  
  672. C ... Lecture du champ par élément à NBCOEL composantes ...
  673.  
  674.       IF(NBCOEL.GT.0) THEN
  675.          READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  676.          IF (TEXT(1:1).EQ.'#') GOTO 9999
  677. CNONF77         READ(LIGNE,*,ERR=9999) NBGRCO
  678.          NRAN=0
  679.          ICOUR=256
  680.          IFINAN=257
  681.          CALL REDLEC(sredle)
  682.          IF(IRE.EQ.1) THEN
  683.             NBGRCO=NFIX
  684.          ELSE
  685.             GOTO 9999
  686.          ENDIF
  687.          SEGINI LISGRC
  688.  
  689. CNONF77         READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  690.          DO 3091 I=1,NBGRCO
  691.             CALL REDLEC(sredle)
  692.             IF(IRE.EQ.1) THEN
  693.                LESGRC(I)=NFIX
  694.             ELSE
  695.                GOTO 9999
  696.             ENDIF
  697.  3091    CONTINUE
  698.  
  699. C    ... On lit les noms et les valeurs des composantes ...
  700.          NBCOMP=NBCOEL
  701.          NBDELE=NBELTS
  702.          SEGINI LISTCO
  703.          K = 0
  704.          DO 3038 I=1,NBGRCO
  705.             READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  706.             IF (TEXT(1:1).EQ.'#') GOTO 9999
  707.             DO 3037 J=1,LESGRC(I)
  708.                K = K + 1
  709. CNONF77               READ(LIGNE,*,END=3099) LESNOM(K)
  710. CNONF77 3099          CONTINUE
  711.                NRAN=0
  712.                ICOUR=256
  713.                IFINAN=257
  714.                CALL REDLEC(sredle)
  715.                IF(IRE.EQ.3) THEN
  716.                   LESNOM(K)=MOT(1:MIN(LOCOMP,NCAR))
  717.                ELSE
  718.                   GOTO 9999
  719.                ENDIF
  720. C          ... Attention à la virgule qui n'est pas considérée comme un
  721. C              séparateur par REDLEC ...
  722.                DO 3092 INUMC=1,MIN(LOCOMP,NCAR)
  723.                   IF(LESNOM(K)(INUMC:INUMC).EQ.',') THEN
  724.                      LESNOM(K)(INUMC:MIN(LOCOMP,NCAR))=' '
  725.                      GOTO 3093
  726.                   ENDIF
  727.  3092          CONTINUE
  728.  3093          CONTINUE
  729.                IF(LESGRC(I).GT.1) THEN
  730.                   IKK=LEN(LESNOM(K))
  731.                   CALL AJNUME(LESNOM(K),IKK,J)
  732.                ENDIF
  733.  3037       CONTINUE
  734.  3038    CONTINUE
  735.          SEGSUP LISGRC
  736.          DO 3039 I=1,NBELTS
  737.             READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  738.             IF (TEXT(1:1).EQ.'#') GOTO 9999
  739. CNONF77            READ(LIGNE,*,END=9999) IKK,(LESCOM(I,J),J=1,NBCOEL)
  740.             NRAN=0
  741.             ICOUR=256
  742.             IFINAN=257
  743.             CALL REDLEC(sredle)
  744.             IF(IRE.EQ.1) THEN
  745.                IKK=NFIX
  746.             ELSE
  747.                GOTO 9999
  748.             ENDIF
  749.             DO 30391 J=1,NBCOEL
  750.                CALL REDLEC(sredle)
  751.                IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  752.                   LESCOM(I,J)=FLOT
  753.                ELSE
  754.                   GOTO 9999
  755.                ENDIF
  756. 30391       CONTINUE
  757.  3039    CONTINUE
  758.  
  759. C    ... On prépare la structure des données ...
  760.          MCHELM=0
  761.          L1=16
  762.          N1=NBSZEL
  763.          N3=6
  764.          SEGINI MCHELM
  765.          TITCHE='CARACTERISTIQUES'
  766.          IFOCHE=IFOUR
  767.          DO 3040 I=1,N1
  768.             CONCHE(I)='                '
  769.             IMACHE(I)=LISTMA.PTMA(I)
  770.             INFCHE(I,1)=0
  771.             INFCHE(I,2)=0
  772.             INFCHE(I,3)=0
  773.             INFCHE(I,4)=0
  774.             INFCHE(I,5)=0
  775.             INFCHE(I,6)=2
  776.             MCHAML=0
  777.             N2=NBCOEL
  778.             SEGINI MCHAML
  779.             ICHAML(I)=MCHAML
  780.             DO 3041 J=1,N2
  781.                NOMCHE(J)=LESNOM(J)
  782.                TYPCHE(J)='REAL*8          '
  783.                MELVAL=0
  784.                N1PTEL=1
  785.                IPT9=LISTMA.PTMA(I)
  786.                SEGACT IPT9
  787.                N1EL=IPT9.NUM(/2)
  788.                SEGDES IPT9
  789.                N2PTEL=0
  790.                N2EL=0
  791.                SEGINI MELVAL
  792.                IELVAL(J)=MELVAL
  793.  3041       CONTINUE
  794.  3040    CONTINUE
  795. C    ... On n'a pas désactivé de segments MCHAML et MELVAL, ce sera fait + tard ...
  796.  
  797. C    ... Le transfert du LESCOM aux VELCHE correspondants ...
  798.          DO I=1,NBCOEL
  799.             DO J=1,NBELTS
  800.                IKK=LISTMA.NUMEMA(J)
  801.                MCHAM1=ICHAML(IKK)
  802.                MELVA1=MCHAM1.IELVAL(I)
  803.                MELVA1.VELCHE(1,LISTMA.NUMELE(J))=LESCOM(J,I)
  804.             ENDDO
  805.          ENDDO
  806.  
  807.          CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,'LEMCHAML',.FALSE.,0,
  808.      &                      'MCHAML  ',0,0.d0,'        ',.FALSE.,MCHELM)
  809.  
  810. C    ... A la fin on désactive le MCHAML avec les dépendances ...
  811.          DO 3046 I=1,NBSZEL
  812.             MCHAM1=ICHAML(I)
  813.             DO 3047 J=1,NBCOEL
  814.                MELVA1=MCHAM1.IELVAL(J)
  815.                SEGDES MELVA1
  816.  3047       CONTINUE
  817.             SEGDES MCHAM1
  818.  3046    CONTINUE
  819.          SEGDES MCHELM
  820.          SEGSUP LISTCO
  821.       ENDIF
  822.  
  823. CDEBUG      WRITE(IOIMP,*) 'MCHAML lu'
  824.  
  825. C ... Lecture des composantes globales ...
  826.  
  827.       IF(NBCOGL.GT.0) THEN
  828.  
  829. C    ... Le nombre de groupes de composantes ...
  830.          READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  831.          IF (TEXT(1:1).EQ.'#') GOTO 9999
  832. CNONF77         READ(LIGNE,*,ERR=9999) NBGRCO
  833.          NRAN=0
  834.          ICOUR=256
  835.          IFINAN=257
  836.          CALL REDLEC(sredle)
  837.          IF(IRE.EQ.1) THEN
  838.             NBGRCO=NFIX
  839.          ELSE
  840.             GOTO 9999
  841.          ENDIF
  842. C    ... permet d'initialiser LISGRC ...
  843.          SEGINI LISGRC
  844.  
  845. C    ... que l'on remplit par la suite ...
  846. CNONF77         READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  847.          DO 3191 I=1,NBGRCO
  848.             CALL REDLEC(sredle)
  849.             IF(IRE.EQ.1) THEN
  850.                LESGRC(I)=NFIX
  851.             ELSE
  852.                GOTO 9999
  853.             ENDIF
  854.  3191    CONTINUE
  855.  
  856. C    ... ensuite on lit les noms des composantes ...
  857.          NBCOMP=NBCOGL
  858.          NBDELE=1
  859.          SEGINI LISTCO
  860.          K = 0
  861.          DO 3138 I=1,NBGRCO
  862.             READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  863.             IF (TEXT(1:1).EQ.'#') GOTO 9999
  864.             DO 3137 J=1,LESGRC(I)
  865.                K = K + 1
  866. CNONF77               READ(LIGNE,*,END=3099) LESNOM(K)
  867. CNONF77 3099          CONTINUE
  868.                NRAN=0
  869.                ICOUR=256
  870.                IFINAN=257
  871.                CALL REDLEC(sredle)
  872.                IF(IRE.EQ.3) THEN
  873.                   LESNOM(K)=MOT(1:NCAR)
  874.                ELSE
  875.                   GOTO 9999
  876.                ENDIF
  877. C          ... Attention à la virgule qui n'est pas considérée comme un
  878. C              séparateur par REDLEC ...
  879.                DO 3192 INUMC=1,MIN(4,NCAR)
  880.                   IF(LESNOM(K)(INUMC:INUMC).EQ.',') THEN
  881.                      LESNOM(K)(INUMC:MIN(4,NCAR))=' '
  882.                      GOTO 3193
  883.                   ENDIF
  884.  3192          CONTINUE
  885.  3193          CONTINUE
  886. C          ... en leur ajoutant (si besoin est) leur N° dans le groupe ...
  887.                IF(LESGRC(I).GT.1) THEN
  888.                   IKK=LEN(LESNOM(K))
  889.                   CALL AJNUME(LESNOM(K),IKK,J)
  890.                ENDIF
  891.  3137       CONTINUE
  892.  3138    CONTINUE
  893.          SEGSUP LISGRC
  894.  
  895. C    ... Puis, on on lit les composantes elles-mêmes ...
  896.          READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  897.          IF (TEXT(1:1).EQ.'#') GOTO 9999
  898. CNONF77         READ(LIGNE,*,END=9999) IKK,(LESCOM(I,J),J=1,NBCOEL)
  899.          NRAN=0
  900.          ICOUR=256
  901.          IFINAN=257
  902.          CALL REDLEC(sredle)
  903.          IF(IRE.EQ.1) THEN
  904.             IKK=NFIX
  905.          ELSE
  906.             GOTO 9999
  907.          ENDIF
  908.          DO 31391 J=1,NBCOGL
  909.             CALL REDLEC(sredle)
  910.             IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  911.                   LESCOM(1,J)=FLOT
  912.             ELSE
  913.                GOTO 9999
  914.             ENDIF
  915. 31391    CONTINUE
  916.  
  917. C    ... À la fin on les met dans la table ...
  918.          DO 31392 J=1,NBCOGL
  919.             MTYPEL(1:4) = LESNOM(J)
  920.             VALFLO      = LESCOM(1,J)
  921.             CALL ECCTAB(MTABLE,
  922.      &           'MOT     ',0,  0.d0,MTYPEL(1:4),.FALSE.,0,
  923.      &           'FLOTTANT',0,VALFLO, '        ',.FALSE.,0)
  924. 31392    CONTINUE
  925.          SEGSUP LISTCO
  926.  
  927.       ENDIF
  928.  
  929. C ... Sortie de la table ...
  930.       CALL ECROBJ('TABLE   ',MTABLE)
  931.       SEGDES MTABLE
  932.  
  933. C ... Fin du traitement du fichier AVS ...
  934.       GOTO 9000
  935.  
  936.  9999 CONTINUE
  937.       CALL ERREUR(703)
  938.  
  939.  9000 CONTINUE
  940.       IF(LISTMA.NE.0) THEN
  941.          SEGSUP LISTMA
  942.       ENDIF
  943.       segsup sredle
  944.  
  945.       END
  946.  
  947.  
  948.  
  949.  

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