Extract the final transmission matrix / energy-angular correlation section

This commit is contained in:
2026-06-18 14:08:16 +02:00
parent e90cab41d5
commit c201d83604
+100 -65
View File
@@ -2694,71 +2694,9 @@ C
C
C TRANSMISSION : MATRICES , ENERGY - ANGULAR CORRELATIONS
C
IF(IT.LT.10000) GO TO 9000
DO J=1,20
MEATL(1,J)=J
ENDDO
EATL(2)=DBLE(MEATL(2,21))/(DBLE(NH)*0.1D0)
DO IERLOG=3,74
EATL(IERLOG)=DBLE(MEATL(IERLOG,21))/(TEMPNH* 10.D0**((IERLOG-1)
& /12.D0))
ENDDO
WRITE(21,2106)
2106 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ',
& '(TRANSMITTED PROJECTILES)'/)
do ima = 74,1,-1
if(meatl(ima,21).ne.0) goto 2105
enddo
ima = 1
2105 ima = min(ima+2,74)
do ies = 1, ima
WRITE(21,1858)elog(ies),(meatl(ies,iag),iag=1,21),eatl(ies)
enddo
WRITE(21,1858)elog(75),(meatl(75,iag),iag=1,21),eatl(75)
IF(ALPHA.LT.1.) GO TO 2110
DO IG2=1,NGIK,1
EEE = IG2*DGI
WRITE(21,2114) EEE
2114 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) AT AZIMUTHAL ANGLE =',F5.1,
& ' (TRANSMITTED PROJECTILES)'/)
do ima = MAXD1,1,-1
if(meagt(ima,ig2,22).ne.0) goto 2115
enddo
ima = 1
2115 ima = min(ima+2,MAXD1)
write (21,1886) ((meagt(ie,ig2,iagb),iagb=1,22),ie=1,ima)
write (21,1886) (meagt(102,ig2,iagb),iagb=1,22)
ENDDO
2110 CONTINUE
WRITE(21,2116)
2116 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (TRANSMITTED PROJECTILES)'/)
do ima = MAXD1,1,-1
if(meat(ima,22).ne.0) goto 2117
enddo
ima = 1
2117 ima = min(ima+2,MAXD1)
write (6, 1886) ((meat(ie,iagb),iagb=1,22),ie=1,ima)
write (6, 1886) (meat(102,iagb),iagb=1,22)
WRITE(21,2118)
2118 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (TRANSMITTED PROJECTILES)'/)
WRITE(21,1886) ((MAGT(IG,IAGB),IAGB=1,22),IG=1,62)
WRITE(21,2122)
2122 FORMAT(//,' AZIMUTH.ANGLE - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (TRANSMITTED ENERGY)'/)
WRITE(21,2127) (EMAT(01,IAGB),IAGB=1,11)
WRITE(21,2125) ((EMAT(IG,IAGB),IAGB=1,11),IG=2,NG)
WRITE(21,2028)
WRITE(21,2131) EMAT(1,1),(EMAT(1,IAGB),IAGB=12,22)
DO IG=2,NG
WRITE(21,2126) EMAT(IG,1),(EMAT(IG,IAGB),IAGB=12,22)
ENDDO
2125 FORMAT(1X,1F5.0,10E11.4)
2126 FORMAT(1X,1F5.0,11E11.4)
2127 FORMAT(1X,1F5.0,10F11.0)
2131 FORMAT(1H1,1X,1F5.0,11F11.0)
call writeTransmissionMatrixSummary(IT,NH,MEATL,EATL,TEMPNH,
& ELOG,ALPHA,NGIK,DGI,MAXD1,MEAGT,MEAT,MAGT,EMAT,NG,
& MAXD2)
9000 CONTINUE
CLOSE(UNIT=21)
CLOSE(UNIT=22)
@@ -2774,6 +2712,103 @@ C=======================================================================
C OUTPUT WRITER SUBROUTINES
C=======================================================================
C
C Write transmission matrix and energy-angle correlation tables.
C
subroutine writeTransmissionMatrixSummary(nTrans,nPrimary,
& transLogMatrix,transLogEnergy,tempNh,energyLog,alpha,
& nAzimuthBins,azimuthBinWidth,maxDepthBins,transEnergyAngle,
& transEnergyPolar,transAngleMatrix,transEnergy,nPolarBins,
& maxDepthBins2)
implicit none
integer*4 nTrans,nPrimary,nAzimuthBins,maxDepthBins
integer*4 nPolarBins,maxDepthBins2
integer*4 j,ierlog,ima,ies,iag,ig2,ie,iagb,ig
integer*4 transLogMatrix(75,21)
integer*4 transEnergyAngle(maxDepthBins2,36,22)
integer*4 transEnergyPolar(maxDepthBins2,22)
integer*4 transAngleMatrix(62,22)
real*8 transLogEnergy(75),tempNh,energyLog(75),alpha
real*8 azimuthBinWidth,eee,transEnergy(62,22)
if(nTrans.lt.10000) return
do j=1,20
transLogMatrix(1,j)=j
enddo
transLogEnergy(2)=dble(transLogMatrix(2,21))/(dble(nPrimary)
& *0.1D0)
do ierlog=3,74
transLogEnergy(ierlog)=dble(transLogMatrix(ierlog,21))/(tempNh
& *10.D0**((ierlog-1)/12.D0))
enddo
write(21,2106)
2106 format(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ',
& '(TRANSMITTED PROJECTILES)'/)
do ima=74,1,-1
if(transLogMatrix(ima,21).ne.0) goto 2105
enddo
ima=1
2105 ima=min(ima+2,74)
do ies=1,ima
write(21,1858) energyLog(ies),(transLogMatrix(ies,iag),
& iag=1,21),transLogEnergy(ies)
enddo
write(21,1858) energyLog(75),(transLogMatrix(75,iag),iag=1,21),
& transLogEnergy(75)
if(alpha.lt.1.) goto 2110
do ig2=1,nAzimuthBins,1
eee=ig2*azimuthBinWidth
write(21,2114) eee
2114 format(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) AT AZIMUTHAL ANGLE =',F5.1,
& ' (TRANSMITTED PROJECTILES)'/)
do ima=maxDepthBins,1,-1
if(transEnergyAngle(ima,ig2,22).ne.0) goto 2115
enddo
ima=1
2115 ima=min(ima+2,maxDepthBins)
write(21,1886) ((transEnergyAngle(ie,ig2,iagb),iagb=1,22),
& ie=1,ima)
write(21,1886) (transEnergyAngle(102,ig2,iagb),iagb=1,22)
enddo
2110 continue
write(21,2116)
2116 format(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (TRANSMITTED PROJECTILES)'/)
do ima=maxDepthBins,1,-1
if(transEnergyPolar(ima,22).ne.0) goto 2117
enddo
ima=1
2117 ima=min(ima+2,maxDepthBins)
write(6,1886) ((transEnergyPolar(ie,iagb),iagb=1,22),ie=1,ima)
write(6,1886) (transEnergyPolar(102,iagb),iagb=1,22)
write(21,2118)
2118 format(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (TRANSMITTED PROJECTILES)'/)
write(21,1886) ((transAngleMatrix(ig,iagb),iagb=1,22),ig=1,62)
write(21,2122)
2122 format(//,' AZIMUTH.ANGLE - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (TRANSMITTED ENERGY)'/)
write(21,2127) (transEnergy(01,iagb),iagb=1,11)
write(21,2125) ((transEnergy(ig,iagb),iagb=1,11),ig=2,
& nPolarBins)
write(21,2028)
write(21,2131) transEnergy(1,1),(transEnergy(1,iagb),iagb=12,22)
do ig=2,nPolarBins
write(21,2126) transEnergy(ig,1),(transEnergy(ig,iagb),
& iagb=12,22)
enddo
1858 format(1X,1E12.4,20I5,I6,1E12.4)
1886 format(1X,I3,20I6,I8)
2028 format(/)
2125 format(1X,1F5.0,10E11.4)
2126 format(1X,1F5.0,11E11.4)
2127 format(1X,1F5.0,10F11.0)
2131 format(1H1,1X,1F5.0,11F11.0)
return
end
C
C Write backscattering matrix and energy-angle correlation tables.
C