C ZPCHEL SOURCE FANDEUR 10/12/17 21:19:00 6815 *--------------------------------------------------------------------* * ECRITURE D'UN OBJET MCHAML * *--------------------------------------------------------------------* SUBROUTINE ZPCHEL (MCHELM,jentet) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC SMCHAML -INC SMLREEL CHARACTER *32 ITEX CHARACTER *40 JTEX CHARACTER *60 TTEX * INITIALISATION DU NOMBRE DE LIGNES PAR PAGE NLIGNE = 57 SEGACT,MCHELM N1=ICHAML(/1) N3=INFCHE(/2) * QUEL MODE DE CALCUL ? IF (IFOCHE.EQ.-3) ITEX='DEFORMATIONS PLANES GENERALISEES' IF (IFOCHE.EQ.-2) ITEX='CONTRAINTES PLANES ' IF (IFOCHE.EQ.-1) ITEX='DEFORMATIONS PLANES ' IF (IFOCHE.EQ.0) ITEX='AXISYMETRIQUE ' IF (IFOCHE.EQ.1) ITEX='SERIE DE FOURIER ' IF (IFOCHE.EQ.2) ITEX='TRIDIMENSIONNEL ' IF (IFOCHE.GE.3.AND.IFOCHE.LE.11) . ITEX='UNIDIMENSIONNEL PLAN ' IF (IFOCHE.GE.12.AND.IFOCHE.LE.14) . ITEX='UNIDIMENSIONNEL AXISYMETRIQUE ' IF (IFOCHE.EQ.15) ITEX='UNIDIMENSIONNEL SPHERIQUE ' L1=TITCHE(/1) LL1=MIN(L1,50) TTEX(1:7)='TYPE : ' TTEX(8:LL1+7)=TITCHE(1:LL1) TTEX(LL1+8:60)=' ' WRITE (IOIMP,'(//)') WRITE (IOIMP,2000) WRITE (IOIMP,2010) WRITE(IOIMP,2100) N1,TTEX,ITEX WRITE (IOIMP,2010) WRITE (IOIMP,2000) 2000 FORMAT (1X,'+',77('-'),'+') 2010 FORMAT (1X,'|',T80,'|') 2100 FORMAT (' | OBJET MCHAML CONTENANT ',I6, . ' ZONE(S) ELEMENTAIRE(S) ' ,T80,'|',/, ' |',T80,'|',/, . ' | ',A60,T80,'|',/, . ' | OPTION DE CALCUL ',A32,T80,'|') *--------------------------------------------------------------------* * BOUCLE SUR LES ZONES ELEMENTAIRES * *--------------------------------------------------------------------* DO IA=1,N1 WRITE(IOIMP,2) IA 2 FORMAT(//10X,' ZONE ELEMENTAIRE NUMERO ',I6/ . 10X,' ------------------------------') MCHAML=ICHAML(IA) SEGACT,MCHAML N2=IELVAL(/1) IF (N3.EQ.0) THEN JTEX=' VALEURS INDEPENDANTES DU REPERE ' WRITE(IOIMP,3) IMACHE(IA),JTEX 3 FORMAT(/1X,' POINTEUR SUR L''OBJET MAILLAGE ',I9/1X,A40) ELSE IF (INFCHE(IA,1).EQ.0) . JTEX=' ' * . JTEX=' VALEURS INDEPENDANTES DU REPERE ' IF (INFCHE(IA,1).EQ.1) . JTEX=' VALEURS DEFINIES DANS LE REPERE LOCAL ' IF (INFCHE(IA,1).EQ.2) . JTEX=' VALEURS DEFINIES DANS LE REPERE GLOBAL' NHARM =INFCHE(IA,3) WRITE(IOIMP,33) IMACHE(IA),JTEX,NHARM TTEX='AUX NOEUDS ' IF (N3.GE.4) THEN IF(INFCHE(IA,4).NE.0) WRITE (IOIMP,34) INFCHE(IA,4) IF (N3.GE.6) THEN IF (INFCHE(IA,6).EQ.0.OR.INFCHE(IA,6).EQ.1) . TTEX='AUX NOEUDS ' IF (INFCHE(IA,6).EQ.2) . TTEX='AU CENTRE DE GRAVITE ' IF (INFCHE(IA,6).EQ.3) . TTEX='AUX POINTS DE GAUSS POUR LA RIGIDITE ' IF (INFCHE(IA,6).EQ.4) . TTEX='AUX POINTS DE GAUSS POUR LA MASSE ' IF (INFCHE(IA,6).EQ.5) . TTEX='AUX POINTS DE GAUSS POUR LES CONTRAINTES ' IF (INFCHE(IA,6).EQ.6) . TTEX='AUX POINTS DE GAUSS POUR LA TEMPERATURE ' IF (INFCHE(IA,6).EQ.7) . TTEX='AUX FACES' IF (INFCHE(IA,6).EQ.8) . TTEX='AUX CENTREP1' IF (INFCHE(IA,6).EQ.9) . TTEX='AUX MSOMMET' ENDIF ENDIF IF(N3.GE.5.AND.INFCHE(IA,5).EQ.1) WRITE(IOIMP,35) WRITE(IOIMP,36) TTEX IF(CONCHE(IA).NE.' ') . WRITE(IOIMP,40) CONCHE(IA) WRITE(IOIMP,39) N2 40 FORMAT (1X,' NOM DU CONSTITUANT ',A24) 39 FORMAT (1X,' NOMBRE DE COMPOSANTES ',I6/) 36 FORMAT (1X,' VALEURS DONNEES ',A60) 35 FORMAT (1X,' FORMULATION MASSIVE') 34 FORMAT (1X,' POINTEUR SUR LES POINTS SUPPORTS ',I9) 33 FORMAT(/1X,' POINTEUR SUR L''OBJET MAILLAGE ',I9/1X,A40/ . 1X,' NUMERO DE L''HARMONIQUE ',I6) ENDIF *--------------------------------------------------------------------* * BOUCLE SUR LES COMPOSANTES * *--------------------------------------------------------------------* DO IB=1,N2 MELVAL=IELVAL(IB) SEGACT,MELVAL N1PTEL=VELCHE(/1) N2PTEL=IELCHE(/1) N1EL=VELCHE(/2) N2EL=IELCHE(/2) NPTEL=MAX(N1PTEL,N2PTEL) NEL=MAX(N1EL,N2EL) IF(IB.EQ.1) THEN WRITE(IOIMP,4) IB,NOMCHE(IB), . TYPCHE(IB)(1:8),TYPCHE(IB)(9:16),melval 4 FORMAT(//2X,I3,'-ERE COMPOSANTE - NOM : ',A8, . ' - TYPE : ',A8,1X,A8,' mel',I10) ELSE WRITE(IOIMP,44) IB,NOMCHE(IB),TYPCHE(IB)(1:8), . TYPCHE(IB)(9:16) , melval 44 FORMAT(//2X,I3,'-EME COMPOSANTE - NOM : ',A8, . ' - TYPE : ',A8,1X,A8,' mel',I10) ENDIF IF (N2PTEL.EQ.0.AND.N2EL.EQ.0) THEN * ECRITURE DES REELS IF (N1EL.EQ.1.AND.N1PTEL.EQ.1) THEN WRITE(IOIMP,341) VELCHE(1,1) 341 FORMAT(/,' CHAMP CONSTANT EGAL A ',1PE11.3) ELSE IF (jentet.EQ.1) N1EL=MIN(N1EL,5) DO L=1,N1EL,5 LH = MIN(L+4,N1EL) WRITE (IOIMP,147) (M,M=L,LH) 147 FORMAT(/,' ELEMENT ',3X,5I12) WRITE (IOIMP,'(1X)') DO J=1,N1PTEL IF (IERR.NE.0) RETURN WRITE(IOIMP,149) J,(VELCHE(J,K),K=L,LH) 149 FORMAT (' POINT ',I2,3X,5(1X,1PE11.3)) ENDDO ENDDO ENDIF ELSE * ECRITURE DES POINTEURS IF (N2EL.EQ.1.AND.N2PTEL.EQ.1) THEN * REPRESENTATION CONSTANTE SUR LE MAILLAGE IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN MLREEL=IELCHE(1,1) SEGACT,MLREEL NREE1=PROG(/1) WRITE(IOIMP,335) NREE1,MLREEL 335 FORMAT(/' CHAMP CONSTANT - LISTE DE',I6, . ' REELS, DE POINTEUR ',I10) IF (NREE1.NE.0) WRITE(IOIMP,336) (PROG(JJ),JJ=1,NREE1) 336 FORMAT(' REELS ',/,(5(1X,1PG12.5))) SEGDES,MLREEL ELSE WRITE(IOIMP,342) IELCHE(1,1) 342 FORMAT(/,' CHAMP CONSTANT - POINTEUR ',I10) ENDIF ELSE * CAS DES LISTREELS IF (jentet.EQ.1) N2EL=MIN(N2EL,10) IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN DO L=1,N2EL WRITE (IOIMP,447) L 447 FORMAT(/,' ELEMENT ',1X,I8) WRITE (IOIMP,'(1X)') DO J=1,N2PTEL IF (IERR.NE.0) RETURN MLREEL=IELCHE(J,L) if(mlreel.eq.0) then nree1=0 else SEGACT,MLREEL NREE1=PROG(/1) SEGDES,MLREEL endif WRITE(IOIMP,425) NREE1,MLREEL 425 FORMAT(/' LISTE DE',I6,' REELS, DE POINTEUR = ',I10) IF (NREE1.NE.0) . WRITE(IOIMP,426) (PROG(JJ),JJ=1,NREE1) 426 FORMAT(' REELS ',/,(10(1X,1PG12.5))) ENDDO ENDDO * LES AUTRES CAS ELSE DO L=1,N2EL,7 LH=MIN(L+6,N2EL) WRITE (IOIMP,247) (M,M=L,LH) 247 FORMAT(/,' ELEMENT ',7I10) WRITE (IOIMP,'(1X)') DO J=1,N2PTEL IF (IERR.NE.0) RETURN IF (TYPCHE(IB).EQ.'POINTEURLISTREEL') THEN MLREEL=IELCHE(J,L) SEGACT,MLREEL NREE1=PROG(/1) WRITE(IOIMP,225) NREE1,MLREEL 225 FORMAT(/' LISTE DE',I6,' REELS, DE POINTEUR = ',I10) IF (NREE1.NE.0) . WRITE(IOIMP,226) (PROG(JJ),JJ=1,NREE1) 226 FORMAT(' REELS ',/,(10(1X,1PG12.5))) SEGDES,MLREEL ELSE WRITE(IOIMP,249) J,(IELCHE(J,K),K=L,LH) 249 FORMAT (' POINT ',I2,7I10) ENDIF ENDDO ENDDO ENDIF ENDIF ENDIF SEGDES,MELVAL ENDDO WRITE(IOIMP,1909) 1909 FORMAT(//) SEGDES,MCHAML ENDDO SEGDES,MCHELM RETURN END