Back to home page

Project CMSSW displayed by LXR

 
 

    


File indexing completed on 2024-04-06 12:15:26

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