File indexing completed on 2024-04-06 12:15:26
0001 PROGRAM AllMaterialMixtures
0002
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
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
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
0061
0062
0063 External Lenocc
0064 Integer Lenocc
0065
0066
0067
0068
0069
0070
0071
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
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
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
0109
0110
0111
0112 Coding = inputstring(1:1)
0113
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
0118
0119
0120
0121
0122
0123 endif
0124
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
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
0155
0156
0157
0158
0159
0160
0161
0162
0163
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
0190
0191 Subroutine MatchMaterial(Index)
0192
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
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
0230
0231
0232
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
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
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
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
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
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
