Back to home page

Project CMSSW displayed by LXR

 
 

    


File indexing completed on 2021-02-14 12:49:04

0001       PROGRAM AllMaterialMixtures
0002 C     ========================
0003 C     Usage example:
0004 C     $ make
0005 C     $ ./mixture $CMSSW_BASE/src/Geometry/TrackerCommonData/data/Materials/pixel_fwd
0006 
0007       IMPLICIT NONE
0008 
0009       Integer Narg, Iarg, Istatus
0010 
0011 
0012       CALL SYSTEM('rm -f do', Istatus)
0013       CALL SYSTEM('touch do', Istatus)
0014 
0015 
0016       Narg = IARGC()
0017 
0018       if (Narg.eq.0) then
0019          write (*,*) "No input file(s) given."
0020          write (*,*) "Usage: mixture FILE"
0021          write (*,*) "Run the mixture program on the input FILE(s)."
0022          write (*,*) "File names without the extension .in!"
0023       endif
0024 
0025 
0026       do Iarg=1, Narg
0027 
0028          call MaterialMixtures(Iarg)
0029          
0030       enddo
0031 
0032 
0033       END
0034 
0035 
0036       SUBROUTINE MaterialMixtures(Iarg)
0037 C     ========================
0038 
0039       IMPLICIT NONE
0040 
0041       Integer Iarg
0042 
0043       Integer ISTAT,i,j,k,l
0044 
0045       Character*1 Coding, Code
0046       Character*120 Filename,OutFile,InFile,tzfile,x0file,l0file
0047       Character*120 inputstring
0048 
0049       Integer Nmix, Ndiv,LunOut,LunIn,Index, Luntz,Lunx0,Lunl0
0050 
0051 C...Common Block .................................................
0052       Integer MaxDiv
0053       Parameter (MaxDiv=30)
0054       Character*40 MixtureName, GMIXName
0055       Character*80 Command
0056       Character*60 Comment(MaxDiv),Material(MaxDiv)
0057       Character*3 Type(MaxDiv)
0058       Real Volume(MaxDiv), Mult(MaxDiv),
0059      +     Density(MaxDiv),Radl(MaxDiv),MCVolume,MCArea
0060       Real Intl(MaxDiv)
0061       Common /MatMix/ Comment, Material,Volume,Mult,Density,Radl,Intl,
0062      +                MCVolume,MCArea,MixtureName,GMIXName,Type
0063 C.................................................................
0064 
0065 
0066       External Lenocc
0067       Integer Lenocc      
0068 
0069 
0070 C... initialization
0071 
0072 C---> read in the input file from standard input
0073 C      write(*,*) " Which file do you want me to open ?"
0074 C      read(*,*) Filename
0075 
0076       CALL GETARG(Iarg , Filename) 
0077 
0078       InFile = Filename(1:LENOCC(Filename))//".in"
0079       OutFile = Filename(1:LENOCC(Filename))//".tex" 
0080       tzfile  = Filename(1:LENOCC(Filename))//".titles"
0081       x0file  = Filename(1:LENOCC(Filename))//".x0"
0082       l0file  = Filename(1:LENOCC(Filename))//".l0"
0083 
0084 C      write(*,*) Filename, InFile, OutFile
0085 
0086       LunIn = 23
0087       LunOut = 24
0088       Luntz = LunOut + 1
0089       Lunx0 = LunOut + 2
0090       Lunl0 = LunOut + 3
0091       open(unit=LunIn,file=InFile,status="OLD",IOSTAT=istat)
0092       if(istat.ne.0) then
0093          write(*,*) "Input file not found. Filename: ", InFile
0094          return
0095       endif
0096 
0097       open(unit=LunOut,file=OutFile,status="REPLACE")
0098       open(unit=Luntz,file=tzfile,status="REPLACE")
0099       open(unit=Lunx0,file=x0file,status="REPLACE")
0100       open(unit=Lunl0,file=l0file,status="REPLACE")
0101       call LatexSetup(LunOut)
0102 
0103 
0104 C---> Big loop over input file
0105 
0106       Nmix = 0
0107       Ndiv = 0
0108       do l = 1, 10000     !! file should not have more lines than that
0109 
0110          read(LunIn,'(A)',END=20) inputstring
0111 C         write(*,*) inputstring
0112          
0113 C...     first check for start of new mixture
0114 
0115          Coding = inputstring(1:1)
0116 C         write(*,*) "Coding ", Coding
0117          if ( Coding.eq.'#') then   ! the next mixture starts
0118             if (Nmix.gt.0) then     ! do everything for the last mixture 
0119                call MakeMixture(NMix,Ndiv,LunOut)
0120 C               write(*,*) "Nmix ", Nmix
0121 C               write(*,*) "Mixture Name:  ", MixtureName, GMixName
0122 C               do j = 1, Ndiv
0123 C                  write(*,*) Code, Index, Comment(j), Material(j),
0124 C     +                 Volume(j), Mult(j), MCVolume
0125 C               enddo
0126             endif
0127 C... reset everything
0128             Call ClearCommon
0129             Nmix = Nmix + 1
0130             Ndiv = 0
0131             read(inputstring,*)  Code,MixtureName,GMIXName,
0132      +           MCVolume,MCArea
0133 
0134          elseif ( Coding.eq.'*') then        ! components
0135             Ndiv = Ndiv + 1
0136             read(inputstring,*) Code, Index, Comment(Ndiv), 
0137      +           Material(Ndiv),Volume(Ndiv), Mult(Ndiv), Type(Ndiv)
0138             call MatchMaterial(Ndiv)
0139             if(Ndiv.ne.Index)  write(*,*) 
0140      +         "******* Inconsistency reading in ",InFile," ******"
0141          endif
0142 
0143       enddo
0144  20   continue
0145 
0146 
0147 C      write(LunOut,*) "\\end{center}"
0148       write(LunOut,*) "\\end{landscape}"
0149       write(LunOut,*) "\\end{document}"
0150 
0151       close(LunIn)
0152       close(LunOut)
0153       close(Luntz)
0154       close(Lunx0)
0155       close(Lunl0)
0156        
0157 C... write out little latex/dvips script
0158 C      open(30,file="do",status="OLD")
0159 C      write(30,*) "latex ",Filename(1:LENOCC(Filename))
0160 C      write(30,*) "dvips ",Filename(1:LENOCC(Filename)),
0161 C     +     " -o",Filename(1:LENOCC(Filename)),".ps"
0162 C      write(30,*) "gv ",Filename(1:LENOCC(Filename))," &"
0163 C      close(30)
0164 
0165 C      write(*,*) "--> I made ",Filename(1:LENOCC(Filename)),
0166 C     +   "  for you. Type ''do'' to see it " 
0167 
0168       write(command,*) "echo 'latex ",Filename(1:LENOCC(Filename)),
0169      +     "' >> do"
0170       CALL SYSTEM(command, istat)
0171 
0172       write(command,*) "echo 'dvips ",Filename(1:LENOCC(Filename)),
0173      +     " -o",Filename(1:LENOCC(Filename)),".ps' ",
0174      +     " >> do"
0175       CALL SYSTEM(command, istat)
0176 
0177       write(command,*) "echo 'gv -landscape ",
0178      +     Filename(1:LENOCC(Filename))," &' ",
0179      +     " >> do"
0180       CALL SYSTEM(command, istat)
0181 
0182       write(command,*) "chmod +x do"
0183       CALL SYSTEM(command, istat)
0184 
0185       write(*,*) "--> I made ",Filename(1:LENOCC(Filename)),
0186      +   "  for you. Type ''do'' to see it " 
0187 
0188       return
0189       end
0190 
0191 
0192 C----------------------------------------------------------------
0193       
0194       Subroutine MatchMaterial(Index)
0195 C     ========================
0196 
0197       Implicit None
0198 
0199       Integer Index, Istat, I,J
0200 
0201       Integer MaxPure
0202       Parameter (MaxPure=350)
0203       Integer NPure,match
0204       CHARACTER*25 PureName(MaxPure)
0205       REAL Pureweight(MaxPure), Purenumber(MaxPure), Puredens(MaxPure),
0206      +     PureX0(MaxPure), PureL0(MaxPure)
0207       SAVE NPure, Pureweight, Purenumber, Puredens, PureX0, PureL0,
0208      +     Purename
0209 
0210       Character*60 string,teststring
0211 
0212       Logical DEBUG,FIRST
0213       DATA FIRST /.TRUE./
0214       DATA DEBUG /.TRUE./
0215 
0216       EXTERNAL LENOCC
0217       Integer LENOCC
0218 
0219 
0220 C...Common Block .................................................
0221       Integer MaxDiv
0222       Parameter (MaxDiv=30)
0223       Character*40 MixtureName, GMIXName
0224       Character*60 Comment(MaxDiv),Material(MaxDiv)
0225       Character*3 Type(MaxDiv)
0226       Real Volume(MaxDiv), Mult(MaxDiv),
0227      +     Density(MaxDiv),Radl(MaxDiv),MCVolume,MCArea
0228       Real Intl(MaxDiv)
0229       Common /MatMix/ Comment, Material,Volume,Mult,Density,Radl,Intl,
0230      +                MCVolume,MCArea,MixtureName,GMIXName,Type
0231 C.................................................................
0232 
0233 
0234 C... read in pure material file
0235       Character MatDir*150
0236       Character MixFile*150
0237       Character PureFile*150
0238       call getenv("CMSSW_BASE", MatDir)
0239       MatDir = MatDir(:lnblnk(MatDir)) // "/src/"
0240      +     // "Geometry/TrackerCommonData/data/Materials/"
0241       if (FIRST) then
0242          PureFile = MatDir(:lnblnk(MatDir)) // "pure_materials.input"
0243          open(unit=22,file= PureFile(:lnblnk(PureFile)),
0244      +        status="OLD", IOSTAT=istat)
0245          if(istat.ne.0) then
0246             write(*,*) "Pure Materials input file could not be opened",
0247      +           " - I quit"
0248             stop
0249          endif
0250 
0251          Npure = 0
0252          do i=1, MaxPure
0253             read(22,*,END=10) PureName(i), Pureweight(i), 
0254      +           PureNumber(i),PureDens(i), PureX0(i), PureL0(i)
0255             Npure = Npure + 1
0256          enddo
0257  10      continue
0258 
0259          close(22)
0260 
0261 C... read in mixed material file
0262          MixFile = MatDir(:lnblnk(MatDir)) // "mixed_materials.input"
0263          open(unit=22, file= MixFile(:lnblnk(MixFile)),
0264      +        status="OLD", IOSTAT=istat)
0265 
0266          if(istat.ne.0) then
0267             write(*,*) "Mixed Materials input file could not be opened",
0268      +           " - I quit"
0269             stop
0270          endif
0271 
0272          do i=Npure+1, MaxPure
0273             read(22,*,END=20) PureName(i), Pureweight(i), 
0274      +           PureNumber(i),PureDens(i), PureX0(i), PureL0(i)
0275             Npure = Npure + 1
0276          enddo
0277  20      continue
0278 
0279          close(22)
0280 C
0281          if (debug) then
0282             write(*,*) "Number of pure materials:  ", Npure
0283             write(*,*) "Material name            ", "A        ",
0284      +           "Z         ",
0285      +           "dens [g/cm3]", "  X_0 [cm]  ","  l_0 [cm]"
0286             do j= 1, NPure
0287                write(*,200) PureName(j), Pureweight(j), 
0288      +              PureNumber(j),PureDens(j), PureX0(j), PureL0(j)
0289             enddo
0290          endif
0291  200     Format(A30,F10.5,F7.0,3F15.5)
0292  201     Format(A30,A30,F10.5,F7.0,3F15.5)
0293 
0294          FIRST = .FALSE.
0295       endif
0296 
0297 C---> try to match material here !
0298 
0299       String = Material(Index)
0300 
0301       if (DEBUG) write(*,*) 'Matching now ', String
0302 
0303       match = 0
0304       Do i = 1,NPure
0305          teststring = PureName(i)
0306          if(teststring(1:LENOCC(teststring)).eq.
0307      +        string(1:LENOCC(string))) then
0308             if (debug)  write(*,201) string, PureName(i), Pureweight(i), 
0309      +           PureNumber(i), PureDens(i), PureX0(i), PureL0(i)
0310             match = 1
0311 C... set density and radiation lenght and nuclear interaction length
0312             Density(Index) = Puredens(I)
0313             Radl(Index) = PureX0(I)
0314             Intl(Index) = PureL0(I)
0315        endif
0316       enddo
0317 
0318       if (match.ne.1)then
0319          write(*,*) "Couldn't find match for material  ",
0320      +        Index, Material(Index)
0321          write(*,*) "Exiting !!"
0322          stop
0323       else
0324          if(Radl(Index).le.0.) then
0325             write(*,*) "Radiation length is zero for material ",
0326      +           Index, Material(Index)
0327          endif
0328          if(Density(Index).le.0) then
0329              write(*,*) "Density is zero for material ",
0330      +           Index, Material(Index)
0331           endif
0332          if(Intl(Index).le.0.) then
0333             write(*,*)
0334      +           "Nuclear Interaction length is zero for material ",
0335      +           Index, Material(Index)
0336          endif
0337       endif
0338 
0339       return
0340       end
0341 
0342 C--------------------------------------------------------------
0343 
0344       Subroutine MakeMixture(Nmix,NMat,LUN)
0345 C     =====================================
0346 
0347       Implicit None
0348 
0349 C...Common Block .................................................
0350       Integer MaxDiv
0351       Parameter (MaxDiv=30)
0352       Character*40 MixtureName, GMIXName
0353       Character*60 Comment(MaxDiv),Material(MaxDiv)
0354       Character*3 Type(MaxDiv)
0355       Real Volume(MaxDiv), Mult(MaxDiv),
0356      +     Density(MaxDiv),Radl(MaxDiv),MCVolume,MCArea
0357       Real Intl(MaxDiv)
0358       Common /MatMix/ Comment, Material,Volume,Mult,Density,Radl,Intl,
0359      +                MCVolume,MCArea,MixtureName,GMIXName,Type
0360 C.................................................................
0361 
0362       Integer NMat, i, j, k,LUN,NMix,LUNTZ,NTZ,Lunx0,Lunl0
0363 
0364       Real TVOL,TDEN,TRAD,Weight,PVOL(MaxDiv),PWeight(MaxDiv)
0365       Real TINT
0366       Real ws(MaxDiv),tmp,PRAD(MaxDiv),Norm,Ndens,NRadl,PRadl
0367       Real ws2(MaxDiv),tmp2,PINT(MaxDiv),NIntl,PIntl
0368 
0369       Real PSUP,PSEN,PCAB,PCOL,PELE
0370       Real PSUP2,PSEN2,PCAB2,PCOL2,PELE2
0371 
0372       Character*60 string,string1,string2,stringmatname
0373 
0374       Character*30 TZName(MaxDiv)
0375       Character*32 tzstring
0376       Real         TZVol(MaxDiv), TZVolTot
0377 
0378       External LENOCC
0379       Integer LENOCC
0380 
0381       character*100 sformat
0382 
0383 C..................................................................
0384 
0385 C..initialize
0386       TVOL = 0.     ! compound volume
0387       TDEN = 0.     ! compound density
0388       TRAD = 0.     ! compound radiation length
0389       Weight = 0.   ! Total weight
0390       TINT = 0.     ! compound nuclear interaction length
0391       call VZERO(PVOL,MaxDiv)
0392       call VZERO(Pweight,MaxDiv)
0393       call VZERO(ws,MaxDiv)
0394       call VZERO(ws2,MaxDiv)
0395       call VZERO(PRAD,MaxDiv)
0396       call VZERO(TZVol,MaxDiv)
0397       tmp = 0.
0398       tmp2 = 0.
0399 
0400 * total volume
0401       do i=1, NMat
0402          Volume(i) = Mult(i)*Volume(i)
0403          TVOL = TVOL + Volume(i)
0404       enddo
0405 
0406       if (tvol.le.0.) return
0407 * percentual volume and total density
0408       do i=1,NMat
0409          PVOL(i) = Volume(i)/TVOL
0410          TDEN = TDEN + PVOL(i)*Density(i)
0411       enddo
0412 
0413 * total weight
0414       Weight = TDEN * TVOL
0415 
0416       do j = 1,NMat
0417 * percentual weight
0418          if(Volume(j).gt.0.) then
0419             PWeight(j) = Density(j)*Volume(j)/Weight
0420 * weight for X0 calculation (pweight/(density*radl))
0421             ws(j) =  Pweight(j)/(Density(j)*Radl(j))
0422             tmp = tmp + ws(j)
0423 * weight for Lambda0 calculation (pweight/(density*intl))
0424             ws2(j) = Pweight(j)/(Density(j)*Intl(j))
0425             tmp2 = tmp2 + ws2(j)
0426          endif
0427       enddo
0428       
0429 * radiation length of compound
0430       TRAD = 1/(tmp*TDEN)
0431 
0432 * nuclear interaction length of compound
0433       TINT = 1/(tmp2*TDEN)
0434 
0435 * contribution to compound X0
0436       do k = 1,NMat
0437          PRAD(k) = ws(k)*TRAD*TDEN
0438       enddo
0439 
0440 * contribution to compound Lambda0
0441       do k = 1,NMat
0442          PINT(k) = ws2(k)*TINT*TDEN
0443       enddo
0444 
0445 * Normalization factor Mixture/MC volume
0446       if (MCVolume.gt.0.) then
0447          Norm = TVOL/MCVolume
0448       else
0449          Norm = 1.
0450       endif
0451 
0452 * Normalized density and radiation length and nuclear interaction length
0453 
0454       ndens = TDEN*Norm
0455       NRadl = TRAD / norm
0456       NIntl = TINT / norm
0457 
0458 * percentual radiation length of compound (if area is given)
0459       if (MCArea.gt.0) then
0460          PRadl = MCVolume/(MCArea*NRadl)
0461       endif
0462 
0463 * percentual nuclear interaction length of compound (if area is given)
0464       if (MCArea.gt.0) then
0465          PIntl = MCVolume/(MCArea*NIntl)
0466       endif
0467 
0468 C---> separate contributions to X_0 by type
0469       PSUP = 0.
0470       PSEN = 0.
0471       PCAB = 0.
0472       PCOL = 0.
0473       PELE = 0.
0474       do i = 1, NMat
0475          if(Type(i).eq."SUP") then
0476             PSUP = PSUP + PRAD(i)
0477          elseif (Type(i).eq."SEN") then
0478             PSEN = PSEN + PRAD(i)
0479          elseif (Type(i).eq."CAB") then
0480             PCAB = PCAB + PRAD(i) 
0481          elseif (Type(i).eq."COL") then
0482             PCOL = PCOL + PRAD(i) 
0483          elseif (Type(i).eq."ELE") then
0484             PELE = PELE + PRAD(i) 
0485          else
0486             write(*,*) "No grouping given for material ",
0487      +           Material(i)
0488          endif
0489       enddo
0490       
0491 C---> separate contributions to Lambda_0 by type
0492       PSUP2 = 0.
0493       PSEN2 = 0.
0494       PCAB2 = 0.
0495       PCOL2 = 0.
0496       PELE2 = 0.
0497       do i = 1, NMat
0498          if(Type(i).eq."SUP") then
0499             PSUP2 = PSUP2 + PINT(i)
0500          elseif (Type(i).eq."SEN") then
0501             PSEN2 = PSEN2 + PINT(i)
0502          elseif (Type(i).eq."CAB") then
0503             PCAB2 = PCAB2 + PINT(i) 
0504          elseif (Type(i).eq."COL") then
0505             PCOL2 = PCOL2 + PINT(i) 
0506          elseif (Type(i).eq."ELE") then
0507             PELE2 = PELE2 + PINT(i) 
0508          else
0509             write(*,*) "No grouping given for material ",
0510      +           Material(i)
0511          endif
0512       enddo
0513 
0514 C---> write out the results ..................
0515 
0516 c$$$      stringmatname = GMIXName
0517 c$$$      call LatexUnderscore(stringmatname)
0518 c$$$      write(LUN,1000) Nmix,MixtureName,stringmatname
0519 c$$$ 1000 Format('\\subsection*{\\underline{',I3,2X,A40,2X,
0520 c$$$     +     '(Material name: ',A40,')',' }}')
0521 c$$$      
0522 c$$$C      write(LUN,*) "\\begin{table}[ht]"
0523 c$$$      write(LUN,*) "\\begin{tabular}{rlrrr}"
0524 c$$$      write(LUN,*) "\\hline\\hline"
0525 c$$$      write(LUN,*) " & Item & \\% Volume & \\% Weight & ",
0526 c$$$     +     "\\% Total X0  \\","\\"
0527 c$$$      write(LUN,*) "\\hline\\hline"
0528 c$$$      
0529 c$$$      do k=1,NMat
0530 c$$$         string = Material(k)
0531 c$$$         call LatexUnderscore(string)
0532 c$$$         write(LUN,1001) k, string(1:LENOCC(string)),100.*PVOL(k),
0533 c$$$     +        100.*Pweight(k),100.*PRAD(k)
0534 c$$$         write(LUN,*) "\\hline"
0535 c$$$      enddo
0536 c$$$ 1001 Format(1X,I4,2X,' & ',A20,' & ',2(1X,F8.3,' & '),1X,F8.3,
0537 c$$$     +     '\\','\\')
0538       
0539 C
0540 C--------------------New big table START
0541 C
0542       stringmatname = GMIXName
0543       call LatexUnderscore(stringmatname)
0544       write(LUN,1000) MixtureName,stringmatname
0545  1000 Format('\\subsection*{\\underline{',2X,A40,2X,
0546      +     '(Material name: ',A40,')',' }}')
0547       
0548 C      write(LUN,*) "\\begin{table}[ht]"
0549       write(LUN,*) "\\begin{tabular}{crlrlrlcrrrr}"
0550 C      write(LUN,*) "\\hline\\hline"
0551       write(LUN,*) " & Component & Material & ",
0552      +     " Volume & \\%  & ",
0553      + " Weight & \\% & Density ",
0554      +     " & X$_0$ & ",
0555      +     " \\% ",
0556      +     " & $\\lambda_0$ & ",
0557      +     " \\% "
0558       write(LUN,*) "\\","\\"
0559       write(LUN,*) " & & & ",
0560      +     " [cm$^3$] & & ",
0561      + " [g] & & [g/cm$^3$]",
0562      +     " & [cm] & ",
0563      +     " ",
0564      +     " & [cm] & ",
0565      +     " "
0566       write(LUN,*) "\\","\\"
0567 C      write(LUN,*) "\\hline\\hline"
0568       write(LUN,*) "\\hline"
0569       
0570       do k=1,NMat
0571          string = Material(k)
0572          string1 = Comment(k)
0573          call LatexUnderscore(string)
0574          call LatexUnderscore(string1)
0575          
0576          if (Volume(k).ge.0.1) then
0577             write(LUN,1001) k,string1(1:LENOCC(string1)),
0578      +           string(1:LENOCC(string)),Volume(k),100.*PVOL(k),
0579      +           Density(k)*Volume(k),
0580      +           100.*Pweight(k),Density(k),Radl(k),100.*PRAD(k),
0581      +           Intl(k),100*PINT(k)
0582         else
0583             write(LUN,2001) k,string1(1:LENOCC(string1)),
0584      +           string(1:LENOCC(string)),Volume(k),100.*PVOL(k),
0585      +           Density(k)*Volume(k),
0586      +           100.*Pweight(k),Density(k),Radl(k),100.*PRAD(k),
0587      +           Intl(k),100*PINT(k)
0588        endif
0589          write(LUN,*) "\\hline"
0590       enddo
0591  1001 Format(1X,I4,2X,' & ',A60,' & ',A20,' & ',
0592      +     (1X,F10.4,' & '),(1X,F12.3,' & '),(1X,F10.4,' & '),
0593      +     5(1X,F12.3,' & '),1X,F12.3,
0594      +     '\\','\\')
0595  2001 Format(1X,I4,2X,' & ',A60,' & ',A20,' & ',
0596      +     (1X,E10.4,' & '),(1X,F12.3,' & '),(1X,E10.4,' & '),
0597      +     5(1X,F12.3,' & '),1X,F12.3,
0598      +     '\\','\\')
0599 
0600 C
0601 C--------------------New big table END
0602 C
0603       write(LUN,*) "\\end{tabular}"
0604 C      write(LUN,*) "\\vskip 0.1cm"
0605       write(LUN,*) " "
0606       write(LUN,*) "\\begin{tabular}{lrr}"
0607       write(LUN,*) "\\fbox{\\begin{tabular}{rl}"
0608       write(LUN,1002) "Mixture density [g/cm$^3$]",TDEN
0609       write(LUN,1002) "Norm. mixture density [g/cm$^3$]",Ndens
0610       write(LUN,1002) "Mixture Volume [cm$^3$]",TVOL
0611       write(LUN,1002) "MC Volume [cm$^3$]",MCVolume
0612       write(LUN,1002) "MC Area [cm$^2]$",MCArea
0613       write(LUN,1002) "Normalization factor",Norm
0614       write(LUN,1002) "Mixture X$_0$ [cm]", TRAD
0615       write(LUN,1002) "Norm. Mixture X$_0$ [cm]",NRadl
0616       if (MCArea.gt.0) then
0617          write(LUN,1002) "Norm. Mixture X$_0$ (\\%)",100*PRadl
0618       endif
0619       write(LUN,1002) "Mixture $\\lambda_0$ [cm]", TINT
0620       write(LUN,1002) "Norm. Mixture $\\lambda_0$ [cm]",NIntl
0621       if (MCArea.gt.0) then
0622          write(LUN,1002) "Norm. Mixture $\\lambda_0$ (\\%)",100*PIntl
0623       endif
0624       write(LUN,1002) "Total weight (g)",weight
0625  1002 Format(A40," & ",F15.5," \\","\\")
0626 
0627       write(LUN,*) "\\end{tabular}} & \\fbox{\\begin{tabular}{rl}"
0628       
0629       write(LUN,1006) "\\underline{X$_0$ contribution}"
0630       write(LUN,1005) "Support: ",PSUP
0631       write(LUN,1005) "Sensitive: ",PSEN
0632       write(LUN,1005) "Cables: ",PCAB
0633       write(LUN,1005) "Cooling: ",PCOL
0634       write(LUN,1005) "Electronics: ", PELE
0635       
0636       write(LUN,*) "\\end{tabular}} & \\fbox{\\begin{tabular}{rl}"
0637       
0638       write(LUN,1006) "\\underline{$\\lambda_0$ contribution}"
0639       write(LUN,1005) "Support: ",PSUP2
0640       write(LUN,1005) "Sensitive: ",PSEN2
0641       write(LUN,1005) "Cables: ",PCAB2
0642       write(LUN,1005) "Cooling: ",PCOL2
0643       write(LUN,1005) "Electronics: ", PELE2
0644       
0645  1005 Format(A25," & ",F5.3,"\\","\\")
0646  1006 Format(A40," & \\","\\")
0647       
0648       write(LUN,*) "\\end{tabular}}\\end{tabular}"
0649       write(LUN,*) "\\clearpage"
0650       
0651 C----> now write out a pseudo title file
0652 
0653       LUNTZ = LUN+1
0654 
0655 C * first add volumes of same material
0656       
0657       Ntz = 0
0658 
0659       do 500 i = 1, NMat  
0660 C.. see if there's a match    
0661          do j = 1, Ntz
0662             if(Material(i)(1:LENOCC(Material(i))).eq.
0663      +           TZName(j)(1:LENOCC(TZName(j))) ) then
0664                TZVol(j) = TZVol(j) + PVol(i)
0665                go to 500
0666             endif
0667          enddo
0668          Ntz = Ntz + 1
0669          TZName(Ntz) = material(i)
0670 C         write(*,*) "Ntz increased: ",NTz, TZName(Ntz)
0671          TZVol(Ntz)  = PVol(i)
0672  500  continue
0673 
0674       TZVolTot = 0.
0675       do i = 1, Ntz
0676          TZVolTot = TZVolTot + TZVol(i)
0677       enddo
0678       if( abs(TZVolTot-1.) .gt. 1.E-6) then
0679          write(*,*) "Percentual Volumes don't add up to 1 !!"
0680       endif
0681 
0682 C      write(*,*) "NTZ: ", Ntz
0683 C      do i =1, Ntz
0684 C         write(*,*) TZName(i)
0685 C      enddo
0686 
0687       tzstring = '"'//GMIXName(1:LENOCC(GMIXName))//'"'
0688       write(LUNTZ,1010) tzstring,-1*Ntz, ndens
0689       do j = 1, Ntz
0690          tzstring = '"'//TZName(j)(1:LENOCC(TZName(j)))//'"'
0691          write(LUNTZ,1011) tzstring, -100.*TZVol(j)
0692       enddo
0693 
0694  1010 Format(7X,A20,I3,4X,F12.6)
0695  1011 Format(10X,A22,F8.3)
0696 
0697 C--> and x0 contributions into a separate file
0698 
0699       Lunx0 = LUN+2
0700       Lunl0 = LUN+3
0701 
0702 C     Original
0703 C     tzstring = '"'//GMIXName(1:LENOCC(GMIXName))//'"'
0704 C     if(PSUP.gt.0.) write(Lunx0,1012) tzstring,'" SUP"',PSUP
0705 C     if(PSEN.gt.0.) write(Lunx0,1012) tzstring,'" SEN"',PSEN
0706 C     if(PCAB.gt.0.) write(Lunx0,1012) tzstring,'" CAB"',PCAB
0707 C     if(PCOL.gt.0.) write(Lunx0,1012) tzstring,'" COL"',PCOL
0708 C     if(PELE.gt.0.) write(Lunx0,1012) tzstring,'" ELE"',PELE
0709 C     write(Lunx0,*) "   "
0710 C     1012 Format(1X,A23,A6,1X,F5.3)
0711 C     
0712 
0713 C     rr
0714       tzstring = GMIXName(1:LENOCC(GMIXName))
0715       write(Lunx0,1012) tzstring,PSUP,PSEN,PCAB,PCOL,PELE
0716       write(Lunx0,*) "   "
0717       tzstring = GMIXName(1:LENOCC(GMIXName))
0718       write(Lunl0,1012) tzstring,PSUP2,PSEN2,PCAB2,PCOL2,PELE2
0719       write(Lunl0,*) "   "
0720  1012 Format(A32,1X,F5.3,1X,F5.3,1X,F5.3,1X,F5.3,1X,F5.3)
0721 C     rr
0722       
0723       return
0724       end
0725 
0726 C----------------------------------------------------------------
0727       
0728       Subroutine ClearCommon
0729 C     ----------------------
0730 
0731       Implicit None
0732 
0733       Integer I
0734 
0735 C...Common Block .................................................
0736       Integer MaxDiv
0737       Parameter (MaxDiv=30)
0738       Character*40 MixtureName, GMIXName
0739       Character*60 Comment(MaxDiv),Material(MaxDiv)
0740       Character*3 Type(MaxDiv)
0741       Real Volume(MaxDiv), Mult(MaxDiv),
0742      +     Density(MaxDiv),Radl(MaxDiv),MCVolume,MCArea
0743       Real Intl(MaxDiv)
0744       Common /MatMix/ Comment, Material,Volume,Mult,Density,Radl,Intl,
0745      +                MCVolume,MCArea,MixtureName,GMIXName,Type
0746 C.................................................................
0747 
0748       do i=1, MaxDiv
0749          Comment(i) = "  "
0750          Material(i) = "  "
0751          Type(i)     = "  "
0752       enddo
0753 
0754       Call VZERO(Volume,MaxDiv)
0755       Call VZERO(Mult,MaxDiv)
0756       Call VZERO(Density,MaxDiv)
0757       Call VZERO(Radl,MaxDiv)
0758       Call VZERO(Intl,MaxDiv)
0759       MCVolume = 0.
0760       MCArea = 0.
0761       MixtureName = " "
0762       GMIXName = " "
0763 
0764       return 
0765       end
0766 
0767 C------------------------------------------------------------------
0768 
0769       Subroutine LatexSetup(LUN)
0770 C     ==========================
0771       
0772       Implicit None
0773       Integer LUN
0774 C--
0775       write(LUN,*) "\\documentclass[10pt]{article}"
0776       write(LUN,*) "\\usepackage{lscape}"
0777       write(LUN,*) "\\usepackage{a4}"
0778       write(LUN,*) "\\pagestyle{empty}"
0779       write(LUN,*) "\\renewcommand{\\baselinestretch}{1.1}"
0780       write(LUN,*) "\\parskip4pt"
0781       write(LUN,*) "\\setlength{\\textwidth}{18cm}"
0782       write(LUN,*) "\\setlength{\\textheight}{28cm}"     
0783       write(LUN,*) "\\addtolength{\\oddsidemargin}{-1.5cm}"
0784       write(LUN,*) "\\addtolength{\\evensidemargin}{-1.5cm}"
0785       write(LUN,*) "\\addtolength{\\topmargin}{-5cm}"
0786       write(LUN,*) "\\begin{document}"
0787       write(LUN,*) "\\begin{landscape}"
0788         
0789       return
0790       end
0791       
0792 
0793 
0794       Subroutine LatexUnderscore(stringname)
0795 C     =======================================
0796       Implicit None
0797       Character*60 stringname,stringtemp
0798       Integer      k,maxunderscore,findunderscore,findspace
0799       Integer      underscorefound
0800       
0801       stringtemp = stringname
0802       findunderscore = 0
0803       k = 0
0804       maxunderscore = 5  !At most maxunderscore '_' searched
0805       underscorefound = 0
0806       
0807 C     Avoid LaTeX errors when compiling names with '_'
0808 c     write(*,*) k,stringname,stringtemp
0809       do k=1,maxunderscore
0810          findunderscore = INDEX(stringtemp,'_')
0811          if(findunderscore.ne.0) then
0812             underscorefound = underscorefound + 1
0813             if(k.eq.1) then
0814                stringname = stringtemp(1:findunderscore-1) // '\\'
0815      +              // stringtemp(findunderscore:findunderscore)
0816             else
0817                findspace = INDEX(stringname,' ')
0818                stringname = stringname(1:findspace-1)
0819      +              // stringtemp(1:findunderscore-1) // '\\'
0820      +              // stringtemp(findunderscore:findunderscore)
0821             endif
0822             stringtemp = stringtemp(findunderscore+1:)
0823          endif
0824 c     write(*,*) k,stringname,stringtemp
0825       enddo
0826       if(underscorefound.ne.0) then
0827          findspace = INDEX(stringname,' ')
0828          stringname = stringname(1:findspace-1) // stringtemp
0829       endif
0830 c     write(*,*) k,stringname,stringtemp
0831       return
0832       end