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    CB215821  25/04/22    21:15:17     12245          
  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, 2)
  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,mclcnf
  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.      .       ' |          CONFIGURATION  ' ,I9     T80,'|')
  62. *--------------------------------------------------------------------*
  63. *     BOUCLE SUR LES ZONES ELEMENTAIRES                              *
  64. *--------------------------------------------------------------------*
  65.       DO IA=1,N1
  66.          MCHAML=ICHAML(IA)
  67.          WRITE(IOIMP,2) IA,MCHAML
  68.     2 FORMAT(//10X,' ZONE ELEMENTAIRE NUMERO ',I6,' : MCH',I10,
  69.      .        /10X,' ----------------------------------------------')
  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 IB=1,N2
  117.             MELVAL=IELVAL(IB)
  118.             N1PTEL=VELCHE(/1)
  119.             N2PTEL=IELCHE(/1)
  120.             N1EL=VELCHE(/2)
  121.             N2EL=IELCHE(/2)
  122.             NPTEL=MAX(N1PTEL,N2PTEL)
  123.             NEL=MAX(N1EL,N2EL)
  124.             IF(IB.EQ.1) THEN
  125.               WRITE(IOIMP,4) IB,NOMCHE(IB),
  126.      .                  TYPCHE(IB)(1:8),TYPCHE(IB)(9:16),melval
  127.     4 FORMAT(//2X,I3,'-ERE COMPOSANTE - NOM : ',A,
  128.      .                ' - TYPE : ',A8,1X,A8,' mel',I10)
  129.  
  130.             ELSEIF (IB.LE.999) THEN
  131.               WRITE(IOIMP,44) IB,NOMCHE(IB),TYPCHE(IB)(1:8),
  132.      .                              TYPCHE(IB)(9:16) , melval
  133.    44 FORMAT(//2X,I3,'-EME COMPOSANTE - NOM : ',A,
  134.      .                ' - TYPE : ',A8,1X,A8,' mel',I10)
  135.             ELSE
  136.               WRITE(IOIMP,444) IB,NOMCHE(IB),TYPCHE(IB)(1:8),
  137.      .                              TYPCHE(IB)(9:16) , melval
  138.   444 FORMAT(//1X,I6,'-EME COMPOSANTE - NOM : ',A,
  139.      .                ' - TYPE : ',A8,1X,A8,' mel',I10)
  140.             ENDIF
  141.  
  142.             IF (N2PTEL.EQ.0.AND.N2EL.EQ.0) THEN
  143. *              ECRITURE DES REELS
  144.              IF (N1EL.EQ.1.AND.N1PTEL.EQ.1) THEN
  145.               WRITE(IOIMP,341) VELCHE(1,1)
  146.  341  FORMAT(/,'   CHAMP CONSTANT EGAL A  ',1PE11.3)
  147.  
  148.              ELSE
  149.               IF (jentet.EQ.1) N1EL=MIN(N1EL,5)
  150.               DO L=1,N1EL,5
  151.                LH = MIN(L+4,N1EL)
  152.                WRITE (IOIMP,147) (M,M=L,LH)
  153.  147  FORMAT(/,'  ELEMENT ',3X,5I12)
  154.                WRITE (IOIMP,'(1X)')
  155.  
  156.                IF (N1PTEL.GT.1) THEN
  157.                 DO J=1,N1PTEL
  158.                   IF (IERR.NE.0) RETURN
  159.                   WRITE(IOIMP,149) J,(VELCHE(J,K),K=L,LH)
  160.  149  FORMAT ('  POINT ',I2,3X,5(1X,1PE11.3))
  161.                 ENDDO
  162.  
  163.                ELSE
  164.                 WRITE(IOIMP,150) (VELCHE(1,K),K=L,LH)
  165.  150  FORMAT ('  CONSTANT ',3X,5(1X,1PE11.3))
  166.                ENDIF
  167.               ENDDO
  168.              ENDIF
  169.             ELSE
  170. *              ECRITURE DES POINTEURS
  171.                IF (N2EL.EQ.1.AND.N2PTEL.EQ.1) THEN
  172. *                 REPRESENTATION CONSTANTE SUR LE MAILLAGE
  173.                   IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN
  174.                      MLREEL=IELCHE(1,1)
  175.                      NREE1=PROG(/1)
  176.                      WRITE(IOIMP,335) NREE1,MLREEL
  177.  335  FORMAT(/'   CHAMP CONSTANT - LISTE DE',I6,
  178.      .        ' REELS, DE POINTEUR ',I10)
  179.                 IF (NREE1.NE.0) WRITE(IOIMP,336) (PROG(JJ),JJ=1,NREE1)
  180.  336  FORMAT('   REELS ',/,(5(1X,1PG12.5)))
  181.                   ELSE
  182.                      WRITE(IOIMP,342) IELCHE(1,1)
  183.  342  FORMAT(/,'   CHAMP CONSTANT - POINTEUR ',I10)
  184.                   ENDIF
  185.                ELSE
  186. *                CAS DES LISTREELS
  187.               IF (jentet.EQ.1) N2EL=MIN(N2EL,10)
  188.               IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN
  189.                 DO L=1,N2EL
  190.                   WRITE (IOIMP,447) L
  191.  447  FORMAT(/,'  ELEMENT ',1X,I8)
  192.                   WRITE (IOIMP,'(1X)')
  193.                   DO J=1,N2PTEL
  194.                     IF (IERR.NE.0) RETURN
  195.                     MLREEL=IELCHE(J,L)
  196.                     if(mlreel.eq.0) then
  197.                       nree1=0
  198.                     else
  199.                       NREE1=PROG(/1)
  200.                     endif
  201.                     WRITE(IOIMP,425) NREE1,MLREEL
  202.  425  FORMAT(/' LISTE DE',I6,' REELS, DE POINTEUR = ',I10)
  203.                     IF (NREE1.NE.0)
  204.      .                  WRITE(IOIMP,426) (PROG(JJ),JJ=1,NREE1)
  205.  426  FORMAT(' REELS ',/,(10(1X,1PG12.5)))
  206.                   ENDDO
  207.                 ENDDO
  208. *          LES AUTRES CAS
  209.               ELSE
  210.                 DO L=1,N2EL,7
  211.                   LH=MIN(L+6,N2EL)
  212.                   WRITE (IOIMP,247) (M,M=L,LH)
  213.  247  FORMAT(/,'  ELEMENT ',7I10)
  214.                   WRITE (IOIMP,'(1X)')
  215.                   DO J=1,N2PTEL
  216.                     IF (IERR.NE.0) RETURN
  217.                     IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN
  218.                       MLREEL=IELCHE(J,L)
  219.                       NREE1=PROG(/1)
  220.                       WRITE(IOIMP,225) NREE1,MLREEL
  221.  225  FORMAT(/' LISTE DE',I6,' REELS, DE POINTEUR = ',I10)
  222.                       IF (NREE1.NE.0)
  223.      .                   WRITE(IOIMP,226) (PROG(JJ),JJ=1,NREE1)
  224.  226  FORMAT(' REELS ',/,(10(1X,1PG12.5)))
  225.                     ELSE
  226.                       WRITE(IOIMP,249) J,(IELCHE(J,K),K=L,LH)
  227.  249  FORMAT('  POINT ',I2,7I10)
  228.                     ENDIF
  229.                   ENDDO
  230.                 ENDDO
  231.               ENDIF
  232.             ENDIF
  233.           ENDIF
  234.         ENDDO
  235.         WRITE(IOIMP,1909)
  236. 1909  FORMAT(//)
  237.       ENDDO
  238.  
  239.       END
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  

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