Télécharger la plaquette Cast3M


fr en

Télécharger zpchel.eso

Retour à la liste

Numérotation des lignes : 

zpchel

  1. C ZPCHEL    SOURCE    GOUNAND   26/07/06    21:15:16     12593          
  2.  
  3. *--------------------------------------------------------------------*
  4. *                 ECRITURE D'UN OBJET MCHAML                         *
  5. *--------------------------------------------------------------------*
  6.  
  7.       SUBROUTINE ZPCHEL (MCHELM,jentet)
  8.  
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC CCGEOME
  15.  
  16. -INC SMCHAML
  17. -INC SMLREEL
  18. -INC SMELEME
  19.  
  20.       CHARACTER *32 ITEX
  21.       CHARACTER *40 JTEX
  22.       CHARACTER *60 TTEX
  23.       CHARACTER *4  MOT4
  24.  
  25. *     INITIALISATION DU NOMBRE DE LIGNES PAR PAGE
  26.       NLIGNE = 57
  27.  
  28.       N1=ICHAML(/1)
  29.  
  30. *     QUEL MODE DE CALCUL ?
  31.       IF (IFOCHE.EQ.-3) ITEX='DEFORMATIONS PLANES GENERALISEES'
  32.       IF (IFOCHE.EQ.-2) ITEX='CONTRAINTES PLANES              '
  33.       IF (IFOCHE.EQ.-1) ITEX='DEFORMATIONS PLANES             '
  34.       IF (IFOCHE.EQ.0)  ITEX='AXISYMETRIQUE                   '
  35.       IF (IFOCHE.EQ.1)  ITEX='SERIE DE FOURIER                '
  36.       IF (IFOCHE.EQ.2)  ITEX='TRIDIMENSIONNEL                 '
  37.       IF (IFOCHE.GE.3.AND.IFOCHE.LE.11)
  38.      &                  ITEX='UNIDIMENSIONNEL PLAN            '
  39.       IF (IFOCHE.GE.12.AND.IFOCHE.LE.14)
  40.      &                  ITEX='UNIDIMENSIONNEL AXISYMETRIQUE   '
  41.       IF (IFOCHE.EQ.15) ITEX='UNIDIMENSIONNEL SPHERIQUE       '
  42.       L1=TITCHE(/1)
  43.       LL1=MIN(L1,50)
  44.       TTEX(1:7)='TYPE : '
  45.       TTEX(8:LL1+7)=TITCHE(1:LL1)
  46.       TTEX(LL1+8:60)=' '
  47.  
  48.       WRITE (IOIMP,'(//)')
  49.       WRITE (IOIMP,2000)
  50.       WRITE (IOIMP,2010)
  51.       WRITE (IOIMP,2100) N1,MCHELM,TTEX,ITEX,mclcnf
  52.       WRITE (IOIMP,2010)
  53.       WRITE (IOIMP,2000)
  54.  2000 FORMAT(1X,'+',77('-'),'+')
  55.  2010 FORMAT(1X,'|',T80,'|')
  56.  2100 FORMAT(' |          OBJET  MCHAML  CONTENANT ',I6,
  57.      .       ' ZONE(S) ELEMENTAIRE(S)',I10,T80,'|',/, ' |',T80,'|',/,
  58.      .       ' |          ',A60,T80,'|',/,
  59.      .       ' |          OPTION DE CALCUL   ',A32,T80,'|',/,
  60.      .       ' |          CONFIGURATION  ' ,I9,T80,'|')
  61. *--------------------------------------------------------------------*
  62. *     BOUCLE SUR LES ZONES ELEMENTAIRES                              *
  63. *--------------------------------------------------------------------*
  64.       DO 1  IA=1,N1
  65.          MCHAML=ICHAML(IA)
  66.          WRITE(IOIMP,2) IA,MCHAML
  67.     2 FORMAT(//10X,' ZONE ELEMENTAIRE NUMERO ',I6,' : MCH',I10,
  68.      .        /10X,' ----------------------------------------------')
  69.          IF (MCHAML.EQ.0) GOTO 1
  70.          N2=IELVAL(/1)
  71.          IF (INFCHE(IA,1).EQ.0)
  72.      .      JTEX='                                        '
  73.          IF (INFCHE(IA,1).EQ.1)
  74.      .      JTEX='  VALEURS DEFINIES DANS LE REPERE LOCAL '
  75.          IF (INFCHE(IA,1).EQ.2)
  76.      .      JTEX='  VALEURS DEFINIES DANS LE REPERE GLOBAL'
  77.          NHARM =INFCHE(IA,3)
  78.          IPT1  =IMACHE(IA)
  79.          MOT4  =NOMS(IPT1.ITYPEL)
  80.          WRITE(IOIMP,33) IPT1,MOT4,JTEX,NHARM
  81.          TTEX='AUX NOEUDS                                '
  82.          IF(INFCHE(IA,4).NE.0) WRITE (IOIMP,34) INFCHE(IA,4)
  83.          IF (INFCHE(IA,6).EQ.0.OR.INFCHE(IA,6).EQ.1)
  84.      .       TTEX='AUX NOEUDS                                '
  85.          IF (INFCHE(IA,6).EQ.2)
  86.      .       TTEX='AU CENTRE DE GRAVITE                      '
  87.          IF (INFCHE(IA,6).EQ.3)
  88.      .       TTEX='AUX POINTS DE GAUSS POUR LA RIGIDITE      '
  89.          IF (INFCHE(IA,6).EQ.4)
  90.      .       TTEX='AUX POINTS DE GAUSS POUR LA MASSE         '
  91.          IF (INFCHE(IA,6).EQ.5)
  92.      .       TTEX='AUX POINTS DE GAUSS POUR LES CONTRAINTES  '
  93.          IF (INFCHE(IA,6).EQ.6)
  94.      .       TTEX='AUX POINTS DE GAUSS POUR LA TEMPERATURE   '
  95.          IF (INFCHE(IA,6).EQ.7)
  96.      .       TTEX='AUX FACES'
  97.          IF (INFCHE(IA,6).EQ.8)
  98.      .       TTEX='AUX CENTREP1'
  99.          IF (INFCHE(IA,6).EQ.9)
  100.      .       TTEX='AUX MSOMMET'
  101.          IF (INFCHE(IA,5).EQ.1) WRITE(IOIMP,35)
  102.             WRITE(IOIMP,36) TTEX
  103.          IF(CONCHE(IA).NE.'                ')
  104.      .      WRITE(IOIMP,40) CONCHE(IA)
  105.          WRITE(IOIMP,39) N2
  106.  40   FORMAT (1X,'  NOM DU CONSTITUANT             ',A24)
  107.  39   FORMAT (1X,'  NOMBRE DE COMPOSANTES          ',I6/)
  108.  36   FORMAT (1X,'  VALEURS DONNEES ',A60)
  109.  35   FORMAT (1X,'  FORMULATION MASSIVE')
  110.  34   FORMAT (1X,'  POINTEUR SUR LES POINTS SUPPORTS  ',I10)
  111.  33   FORMAT(/1X,'  POINTEUR SUR L''OBJET MAILLAGE ',I10,' : ''',A4
  112.      .      ,''''/,/1X,A40/1X,'  NUMERO DE L''HARMONIQUE         ',I6)
  113. *--------------------------------------------------------------------*
  114. *        BOUCLE SUR LES COMPOSANTES                                  *
  115. *--------------------------------------------------------------------*
  116.         DO 10 IB=1,N2
  117.            MELVAL=IELVAL(IB)
  118.            IF (MELVAL.EQ.0) THEN
  119.               WRITE(IOIMP,4444) IB,melval
  120.  4444         FORMAT(//2X,I3,'-ERE COMPOSANTE - ! VIDE !  mel',I10)
  121.               GOTO 10
  122.            ENDIF
  123.             N1PTEL=VELCHE(/1)
  124.             N2PTEL=IELCHE(/1)
  125.             N1EL=VELCHE(/2)
  126.             N2EL=IELCHE(/2)
  127.             NPTEL=MAX(N1PTEL,N2PTEL)
  128.             NEL=MAX(N1EL,N2EL)
  129.             IF(IB.EQ.1) THEN
  130.               WRITE(IOIMP,4) IB,NOMCHE(IB),
  131.      .                  TYPCHE(IB)(1:8),TYPCHE(IB)(9:16),melval
  132.     4 FORMAT(//2X,I3,'-ERE COMPOSANTE - NOM : ',A,
  133.      .                ' - TYPE : ',A8,1X,A8,' mel',I10)
  134.  
  135.             ELSEIF (IB.LE.999) THEN
  136.               WRITE(IOIMP,44) IB,NOMCHE(IB),TYPCHE(IB)(1:8),
  137.      .                              TYPCHE(IB)(9:16) , melval
  138.    44 FORMAT(//2X,I3,'-EME COMPOSANTE - NOM : ',A,
  139.      .                ' - TYPE : ',A8,1X,A8,' mel',I10)
  140.             ELSE
  141.               WRITE(IOIMP,444) IB,NOMCHE(IB),TYPCHE(IB)(1:8),
  142.      .                              TYPCHE(IB)(9:16) , melval
  143.   444 FORMAT(//1X,I6,'-EME COMPOSANTE - NOM : ',A,
  144.      .                ' - TYPE : ',A8,1X,A8,' mel',I10)
  145.             ENDIF
  146.  
  147.             IF (N2PTEL.EQ.0.AND.N2EL.EQ.0) THEN
  148. *              ECRITURE DES REELS
  149.              IF (N1EL.EQ.1.AND.N1PTEL.EQ.1) THEN
  150.               WRITE(IOIMP,341) VELCHE(1,1)
  151.  341  FORMAT(/,'   CHAMP CONSTANT EGAL A  ',1PE11.3)
  152.  
  153.              ELSE
  154.               IF (jentet.EQ.1) N1EL=MIN(N1EL,5)
  155.               DO L=1,N1EL,5
  156.                LH = MIN(L+4,N1EL)
  157.                WRITE (IOIMP,147) (M,M=L,LH)
  158.  147  FORMAT(/,'  ELEMENT ',3X,5I12)
  159. *               WRITE (IOIMP,'(1X)')
  160.  
  161.                IF (N1PTEL.GT.1) THEN
  162.                 DO J=1,N1PTEL
  163.                   IF (IERR.NE.0) RETURN
  164.                   WRITE(IOIMP,149) J,(VELCHE(J,K),K=L,LH)
  165.  149  FORMAT ('  POINT ',I2,3X,5(1X,1PE11.3))
  166.                 ENDDO
  167.  
  168.                ELSE
  169.                 WRITE(IOIMP,150) (VELCHE(1,K),K=L,LH)
  170.  150  FORMAT ('  CONSTANT ',3X,5(1X,1PE11.3))
  171.                ENDIF
  172.               ENDDO
  173.              ENDIF
  174.             ELSE
  175. *              ECRITURE DES POINTEURS
  176.                IF (N2EL.EQ.1.AND.N2PTEL.EQ.1) THEN
  177. *                 REPRESENTATION CONSTANTE SUR LE MAILLAGE
  178.                   IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN
  179.                      MLREEL=IELCHE(1,1)
  180.                      NREE1=PROG(/1)
  181.                      WRITE(IOIMP,335) NREE1,MLREEL
  182.  335  FORMAT(/'   CHAMP CONSTANT - LISTE DE',I6,
  183.      .        ' REELS, DE POINTEUR ',I10)
  184.                 IF (NREE1.NE.0) WRITE(IOIMP,336) (PROG(JJ),JJ=1,NREE1)
  185.  336  FORMAT('   REELS ',/,(5(1X,1PG12.5)))
  186.                   ELSE
  187.                      WRITE(IOIMP,342) IELCHE(1,1)
  188.  342  FORMAT(/,'   CHAMP CONSTANT - POINTEUR ',I10)
  189.                   ENDIF
  190.                ELSE
  191. *                CAS DES LISTREELS
  192.               IF (jentet.EQ.1) N2EL=MIN(N2EL,10)
  193.               IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN
  194.                 DO L=1,N2EL
  195.                   WRITE (IOIMP,447) L
  196.  447  FORMAT(/,'  ELEMENT ',1X,I8)
  197. *                  WRITE (IOIMP,'(1X)')
  198.                   DO J=1,N2PTEL
  199.                     IF (IERR.NE.0) RETURN
  200.                     MLREEL=IELCHE(J,L)
  201.                     if(mlreel.eq.0) then
  202.                       nree1=0
  203.                     else
  204.                       NREE1=PROG(/1)
  205.                     endif
  206.                     WRITE(IOIMP,425) NREE1,MLREEL
  207.  425  FORMAT(/' LISTE DE',I6,' REELS, DE POINTEUR = ',I10)
  208.                     IF (NREE1.NE.0)
  209.      .                  WRITE(IOIMP,426) (PROG(JJ),JJ=1,NREE1)
  210.  426  FORMAT(' REELS ',/,(10(1X,1PG12.5)))
  211.                   ENDDO
  212.                 ENDDO
  213. *          LES AUTRES CAS
  214.               ELSE
  215.                 DO L=1,N2EL,7
  216.                   LH=MIN(L+6,N2EL)
  217.                   WRITE (IOIMP,247) (M,M=L,LH)
  218.  247  FORMAT(/,'  ELEMENT ',7I10)
  219. *                  WRITE (IOIMP,'(1X)')
  220.                   DO J=1,N2PTEL
  221.                     IF (IERR.NE.0) RETURN
  222.                     IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN
  223.                       MLREEL=IELCHE(J,L)
  224.                       NREE1=PROG(/1)
  225.                       WRITE(IOIMP,225) NREE1,MLREEL
  226.  225  FORMAT(/' LISTE DE',I6,' REELS, DE POINTEUR = ',I10)
  227.                       IF (NREE1.NE.0)
  228.      .                   WRITE(IOIMP,226) (PROG(JJ),JJ=1,NREE1)
  229.  226  FORMAT(' REELS ',/,(10(1X,1PG12.5)))
  230.                     ELSE
  231.                       WRITE(IOIMP,249) J,(IELCHE(J,K),K=L,LH)
  232.  249  FORMAT('  POINT ',I2,7I10)
  233.                     ENDIF
  234.                   ENDDO
  235.                ENDDO
  236.             ENDIF
  237.          ENDIF
  238.       ENDIF
  239.  10   CONTINUE
  240.       WRITE(IOIMP,1909)
  241. 1909  FORMAT(//)
  242.  1    CONTINUE
  243.       END
  244.  
  245.  

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