[u/mrichter/AliRoot.git] / GEANT321 / gcons / gpmate.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:15  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
*-- Author :
      SUBROUTINE GPMATE (NUMB)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       Routine to print material data structures JMATE          *
C.    *       NUMB     Material number                                 *
C.    *                                                                *
C.    *      Changed by S.Egli at 8.5.90: also show mixture contents   *
C.    *                                                                *
C.    *    ==>Called by : <USER>, GPRINT                               *
C.    *       Author    R.Brun  *********                              *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcnum.inc"
      CHARACTER CHMIXT*17
C.
C.    ------------------------------------------------------------------
C.
      IF (JMATE.LE.0) GO TO 999
      IF (NUMB .EQ.0) THEN
         WRITE (CHMAIL,10000)
         CALL GMAIL(0,0)
         N1     = 1
         N2     = NMATE
      ELSE
         N1     = ABS(NUMB)
         N2     = ABS(NUMB)
      ENDIF
      IF(NUMB.GE.0) THEN
         WRITE (CHMAIL,10100)
         CALL GMAIL(0,1)
      ENDIF
C
      DO 20 I=N1,N2
         JMA = LQ(JMATE-I)
         IF (JMA.LE.0) GO TO 20
C
         NMIXT=Q(JMA+11)
         CHMIXT=' '
         IF(NMIXT.GT.1) CHMIXT='   A      Z     W'
         WRITE (CHMAIL,10200) I,(Q(JMA + J),J = 1,10),NMIXT,CHMIXT
         CALL GMAIL(0,0)
         IF(NMIXT.GT.1)THEN
            JMX=LQ(JMA-5)
            DO 10 J=1,NMIXT
               WRITE(CHMAIL,10300)Q(JMX+J),Q(JMX+NMIXT+J),
     +         Q(JMX+2*NMIXT+J)
               CALL GMAIL(0,0)
   10       CONTINUE
         ENDIF
   20 CONTINUE
C
10000 FORMAT ('0',51('='),5X,'MATERIALS',6X,50('='))
10100 FORMAT ('0','MATERIAL',27X,'A',9X,'Z',5X,'DENSITY'
     +,2X,'RADIAT L',2X,'ABSORP L',' NMIXT')
10200 FORMAT (' ',I8,1X,5A4,3F10.3,2E10.3,I4,2X,A17)
10300 FORMAT (' ',85X,2F7.2,F7.3)
  999 END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:15 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.19 by S.Giani
	11	*-- Author :
	12	SUBROUTINE GPMATE (NUMB)
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * Routine to print material data structures JMATE *
	17	C. * NUMB Material number *
	18	C. * *
	19	C. * Changed by S.Egli at 8.5.90: also show mixture contents *
	20	C. * *
	21	C. * ==>Called by : <USER>, GPRINT *
	22	C. * Author R.Brun ********* *
	23	C. * *
	24	C. ******************************************************************
	25	C.
	26	#include "geant321/gcbank.inc"
	27	#include "geant321/gcunit.inc"
	28	#include "geant321/gcnum.inc"
	29	CHARACTER CHMIXT*17
	30	C.
	31	C. ------------------------------------------------------------------
	32	C.
	33	IF (JMATE.LE.0) GO TO 999
	34	IF (NUMB .EQ.0) THEN
	35	WRITE (CHMAIL,10000)
	36	CALL GMAIL(0,0)
	37	N1 = 1
	38	N2 = NMATE
	39	ELSE
	40	N1 = ABS(NUMB)
	41	N2 = ABS(NUMB)
	42	ENDIF
	43	IF(NUMB.GE.0) THEN
	44	WRITE (CHMAIL,10100)
	45	CALL GMAIL(0,1)
	46	ENDIF
	47	C
	48	DO 20 I=N1,N2
	49	JMA = LQ(JMATE-I)
	50	IF (JMA.LE.0) GO TO 20
	51	C
	52	NMIXT=Q(JMA+11)
	53	CHMIXT=' '
	54	IF(NMIXT.GT.1) CHMIXT=' A Z W'
	55	WRITE (CHMAIL,10200) I,(Q(JMA + J),J = 1,10),NMIXT,CHMIXT
	56	CALL GMAIL(0,0)
	57	IF(NMIXT.GT.1)THEN
	58	JMX=LQ(JMA-5)
	59	DO 10 J=1,NMIXT
	60	WRITE(CHMAIL,10300)Q(JMX+J),Q(JMX+NMIXT+J),
	61	+ Q(JMX+2*NMIXT+J)
	62	CALL GMAIL(0,0)
	63	10 CONTINUE
	64	ENDIF
65	20 CONTINUE
66	C
67	10000 FORMAT ('0',51('='),5X,'MATERIALS',6X,50('='))
68	10100 FORMAT ('0','MATERIAL',27X,'A',9X,'Z',5X,'DENSITY'
69	+,2X,'RADIAT L',2X,'ABSORP L',' NMIXT')
70	10200 FORMAT (' ',I8,1X,5A4,3F10.3,2E10.3,I4,2X,A17)
71	10300 FORMAT (' ',85X,2F7.2,F7.3)
72	999 END