From 7bf206f2476889db17be531a0051f126385882e1 Mon Sep 17 00:00:00 2001
From: Giacomo Mulas <giacomo.mulas@inaf.it>
Date: Mon, 4 Sep 2023 12:15:31 +0000
Subject: [PATCH] Upload New File
---
cluster/edfb.f | 336 +++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 336 insertions(+)
create mode 100644 cluster/edfb.f
diff --git a/cluster/edfb.f b/cluster/edfb.f
new file mode 100644
index 00000000..e54ab746
--- /dev/null
+++ b/cluster/edfb.f
@@ -0,0 +1,336 @@
+ PROGRAM EDFB
+CCC 160630
+CCC IES=1 FOR SURROUNDING EXTERNAL SPHERE CENTERED AT ORIGIN;
+CCC HOMOGENEOUS MATERIAL WITHIN THE EXT. SPHERE IS READ IN
+CCC AS THAT OF THE (NSHL+1)-TH LAYER OF THE 1-ST SPHERE:
+CCC RCF(1,NSHL)=1.0D0, RCF(1,NSHL+1)>1.0D0 AND
+CCC ROS(1) IS RADIUS OF SPHERE 1
+CCC
+CCC READ DATA FOR BUILDING VECTOR XIV FROM WITHIN SUB INXI
+CCC
+CCC IDFC>0 WHEN ALL DIEL. FUNCT. OF SPHERES ARE CONSTANTS;
+CCC IDFC=0 WHEN DIEL. FUNCT. OF SPHERES DEPEND ON XI;
+CCC IDFC<0 WHEN DIEL. FUNCT. OF SPHERES ARE AT XIP VALUE ONLY AND
+CCC XI IS SCALE FACTOR FOR DIMENSIONS
+CCC INSN CHOOSES THE VARIABLE THE DIEL. FUNCT. DEPEND ON:
+CCC (INSN=1)=XI;
+CCC (INSN=2)=WN (THE WAVENUMBER, IN m**-1);
+CCC (INSN=3)=WL (THE WAVELENGTH, IN m);
+CCC (INSN=4)=PU (THE ANGULAR FREQUENCY, IN s**-1);
+CCC (INSN=5)=EV (THE PHOTON ENERGY, IN ev);
+CCC INSTPC>0 WHEN VARIABLE INCREASES WITH A CONSTANT STEP;
+CCC INSTPC=0 WHEN VARIABLE IS SAVED IN A VECTOR YOU READ BEFORE
+CCC SUPPORTS EXPERIMENTAL DIELECTRIC FUNCTIONS ONLY
+CCC NSPH=6
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC COMMON/C1/DC0(NSHL-NTL+1),DC0M(NSHL-NTL+1,NSPH,NXI),
+CCC 1ROS(NSPH),RCF(NSPH,NSHL+1),IOG(NSPH),NSHL(NSPH)
+ COMMON/C1/DC0(5),DC0M(5,6,200),
+ 1ROS(6),RCF(6,9),IOG(6),NSHL(6)
+ COMPLEX*16 DC0,DC0M
+CCC COMMON/C3/XIV(NXI),WNS(NXI),WLS(NXI),PUS(NXI),EVS(NXI),
+CCC 1VSS(NXI),VNS(5)
+ COMMON/C3/XIV(200),WNS(200),WLS(200),PUS(200),EVS(200),
+ 1VSS(200),VNS(5)
+ CHARACTER*3 VNS
+ 5010 FORMAT(16I5)
+ 6005 FORMAT(' SPHERE N.',I4)
+ 6009 FORMAT(' NONTRANSITION LAYER N.',I2,', SCALE = ',A3)
+ 6010 FORMAT(I5,1X,1PD12.4,1PD12.4)
+ IR=5
+ IW=6
+ IT=7
+CCC
+CCC SIZE(I)=VK*ROS(I) IS SIZE PARAMETER in vacuo
+CCC
+CCC
+CCC READING OF DIELECTRIC FUNCTIONS DRIVEN BY ICI DEFINED BELOW
+CCC
+ OPEN(IR,FILE='DEDFB',STATUS='OLD')
+ READ(IR,*)NSPH,IES
+ IF(IES.NE.0)IES=1
+ READ(IR,*)EXDC,WP,XIP,IDFC,NXI,INSTPC,INSN
+ OPEN(IW,FILE='OEDFB',STATUS='UNKNOWN')
+ CALL INXI(IR,IW,WP,XIP,IDFC,NXI,INSTPC,INSN)
+ READ(IR,5010)(IOG(I),I=1,NSPH)
+ DO 113 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 113
+ READ(IR,*)NSHL(I),ROS(I)
+ NSH=NSHL(I)
+ IF(I.EQ.1)NSH=NSH+IES
+ DO 112 NS=1,NSH
+ 112 READ(IR,*)RCF(I,NS)
+ 113 CONTINUE
+ OPEN(IT,FILE='TEDF',FORM='UNFORMATTED',STATUS='UNKNOWN')
+ WRITE(IT)NSPH
+ WRITE(IT)(IOG(I),I=1,NSPH)
+ WRITE(IT)EXDC,WP,XIP,IDFC,NXI
+ WRITE(IT)(XIV(I),I=1,NXI)
+ DO 115 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 115
+ WRITE(IT)NSHL(I),ROS(I)
+ NSH=NSHL(I)
+ IF(I.EQ.1)NSH=NSH+IES
+ WRITE(IT)(RCF(I,NS),NS=1,NSH)
+ 115 CONTINUE
+ DO 468 JXI=1,NXI
+ IF((IDFC.NE.0).AND.(JXI.GT.1))GO TO 468
+ DO 162 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 162
+CCC
+ NSH=NSHL(I)
+ ICI=(NSH+1)/2
+ IF(I.EQ.1)ICI=ICI+IES
+ DO 157 IC=1,ICI
+ READ(IR,*)DC0(IC)
+ 157 DC0M(IC,I,JXI)=DC0(IC)
+CCC
+ WRITE(IT)(DC0(IC),IC=1,ICI)
+ 162 CONTINUE
+ 468 CONTINUE
+ IF(IDFC.EQ.0)GO TO 474
+ WRITE(IW,*)' DIELECTRIC CONSTANTS'
+ DO 473 I=1,NSPH
+ IF(IOG(I).NE.I)GO TO 473
+ ICI=(NSHL(I)+1)/2
+ IF(I.EQ.1)ICI=ICI+IES
+ WRITE(IW,6005)I
+ DO 472 IC=1,ICI
+ WRITE(IW,6010)IC,DC0M(IC,I,1)
+ 472 CONTINUE
+ 473 CONTINUE
+ GO TO 499
+ 474 WRITE(IW,*)' DIELECTRIC FUNCTIONS'
+ DO 478 I=1,NSPH
+ IF(IOG(I).NE.I)GO TO 478
+ ICI=(NSHL(I)+1)/2
+ IF(I.EQ.1)ICI=ICI+IES
+ WRITE(IW,6005)I
+ DO 477 IC=1,ICI
+ WRITE(IW,6009)IC,VNS(INSN)
+ DO 476 JXI=1,NXI
+ WRITE(IW,6010)JXI,DC0M(IC,I,JXI)
+ 476 CONTINUE
+ 477 CONTINUE
+ 478 CONTINUE
+ 499 CLOSE(IR)
+ CLOSE(IW)
+ CLOSE(IT)
+ STOP
+ END
+ SUBROUTINE INXI(IR,IW,WP,XIP,IDFC,NXI,INSTPC,INSN)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C3/XIV(200),WNS(200),WLS(200),PUS(200),EVS(200),
+ 1VSS(200),VNS(5)
+ CHARACTER*3 VNS
+ PIGT=DACOS(0.0D0)*4.0D0
+ EVC=6.5821188D-16
+ IF(IDFC.LT.0)GO TO 300
+ IF(INSTPC.EQ.0)GO TO 200
+CCC VLST=V+(NXI-1)*VSTP
+ GO TO(105,125,145,165,185),INSN
+ RETURN
+ 105 READ(IR,*)XI,XISTP
+ DO 110 JXI=1,NXI
+ PU=XI*WP
+ WN=PU/3.0D08
+ VNS(INSN)='XIV'
+ VSS(JXI)=XI
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 110 XI=XI+XISTP
+ WRITE(IW,6601)
+ 6601 FORMAT
+ 1(2X,'JXI',5X,'XIV',10X,'WNS',10X,'WLS',10X,'PUS',10X,'EVS')
+ WRITE(IW,6600)
+ 1(JXI,XIV(JXI),WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),JXI=1,NXI)
+ 6600 FORMAT((I5,5(1PD13.4)))
+ RETURN
+ 125 READ(IR,*)WN,WNSTP
+ DO 130 JXI=1,NXI
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WNS'
+ VSS(JXI)=WN
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 130 WN=WN+WNSTP
+ WRITE(IW,6602)
+ 6602 FORMAT
+ 1(2X,'JXI',5X,'WNS',10X,'WLS',10X,'PUS',10X,'EVS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 145 READ(IR,*)WL,WLSTP
+ DO 150 JXI=1,NXI
+ WN=PIGT/WL
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WLS'
+ VSS(JXI)=WL
+ WLS(JXI)=WL
+ WNS(JXI)=WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 150 WL=WL+WLSTP
+ WRITE(IW,6603)
+ 6603 FORMAT
+ 1(2X,'JXI',5X,'WLS',10X,'WNS',10X,'PUS',10X,'EVS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,WLS(JXI),WNS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 165 READ(IR,*)PU,PUSTP
+ DO 170 JXI=1,NXI
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='PUS'
+ VSS(JXI)=PU
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ EVS(JXI)=PU*EVC
+ 170 PU=PU+PUSTP
+ WRITE(IW,6604)
+ 6604 FORMAT
+ 1(2X,'JXI',5X,'PUS',10X,'WNS',10X,'WLS',10X,'EVS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,PUS(JXI),WNS(JXI),WLS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 185 READ(IR,*)EV,EVSTP
+ DO 190 JXI=1,NXI
+ PU=EV/EVC
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='EVS'
+ VSS(JXI)=EV
+ EVS(JXI)=EV
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 190 EV=EV+EVSTP
+ WRITE(IW,6605)
+ 6605 FORMAT
+ 1(2X,'JXI',5X,'EVS',10X,'WNS',10X,'WLS',10X,'PUS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,EVS(JXI),WNS(JXI),WLS(JXI),PUS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 200 GO TO(205,225,245,265,285),INSN
+ RETURN
+ 205 DO 210 JXI=1,NXI
+ READ(IR,*)XI
+ PU=XI*WP
+ WN=PU/3.0D08
+ VNS(INSN)='XIV'
+ VSS(JXI)=XI
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 210 CONTINUE
+ WRITE(IW,6601)
+ WRITE(IW,6600)
+ 1(JXI,XIV(JXI),WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),JXI=1,NXI)
+ RETURN
+ 225 DO 230 JXI=1,NXI
+ READ(IR,*)WN
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WNS'
+ VSS(JXI)=WN
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 230 CONTINUE
+ WRITE(IW,6602)
+ WRITE(IW,6600)
+ 1(JXI,WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 245 DO 250 JXI=1,NXI
+ READ(IR,*)WL
+ WN=PIGT/WL
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WLS'
+ VSS(JXI)=WL
+ WLS(JXI)=WL
+ WNS(JXI)=WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 250 CONTINUE
+ WRITE(IW,6603)
+ WRITE(IW,6600)
+ 1(JXI,WLS(JXI),WNS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 265 DO 270 JXI=1,NXI
+ READ(IR,*)PU
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='PUS'
+ VSS(JXI)=PU
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ EVS(JXI)=PU*EVC
+ 270 CONTINUE
+ WRITE(IW,6604)
+ WRITE(IW,6600)
+ 1(JXI,PUS(JXI),WNS(JXI),WLS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 285 DO 290 JXI=1,NXI
+ READ(IR,*)EV
+ PU=EV/EVC
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='EVS'
+ VSS(JXI)=EV
+ EVS(JXI)=EV
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 290 CONTINUE
+ WRITE(IW,6605)
+ WRITE(IW,6600)
+ 1(JXI,EVS(JXI),WNS(JXI),WLS(JXI),PUS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 300 IF(INSTPC.GT.0)GO TO 315
+ DO 310 JXI=1,NXI
+ READ(IR,*)XI
+ VNS(INSN)='XIV'
+ VSS(JXI)=XI
+ XIV(JXI)=XI
+ 310 CONTINUE
+ GO TO 330
+ 315 READ(IR,*)XI,XISTP
+ DO 320 JXI=1,NXI
+ VNS(INSN)='XIV'
+ VSS(JXI)=XI
+ XIV(JXI)=XI
+ 320 XI=XI+XISTP
+ 330 PU=XIP*WP
+ WN=PU/3.0D08
+ WRITE(IW,6611)
+ 6611 FORMAT
+ 1(10X,'XIP',10X,'WN ',10X,'WL ',10X,'PU ',10X,'EV')
+ WRITE(IW,6610)XIP,WN,PIGT/WN,PU,PU*EVC
+ 6610 FORMAT((5X,5(1PD13.4)))
+ WRITE(IW,*)' SCALE FACTORS XI'
+ WRITE(IW,6612)(JXI,XIV(JXI),JXI=1,NXI)
+ 6612 FORMAT(I5,1PD13.4)
+ RETURN
+ END
+CCC
\ No newline at end of file
--
GitLab