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