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

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