Télécharger zpchel.eso

Retour à la liste

Numérotation des lignes :

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

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