epsi
/
msspec_python3
3
0
Fork 0
Code Issues 6 Pull Requests Releases Wiki Activity

Replaced STOP by RETURN before error print statements in src/msspec/spec/fortran/eig/mi/do_main.f 

In src/msspec/spec/fortran/eig/common/, modified eig_mat_ms.f to call subroutines in new
files diagonalize_matrix.f and renormalization.f to implement renormalization in the
eigenvalue "spectroscopy"
This commit is contained in:
Kevin Dunseath 2019-12-11 15:12:58 +01:00
parent 3c387c8585
commit 50a0bb7632
4 changed files with 317 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
src/msspec/spec/fortran/eig/common/diagonalize_matrix.f Normal file
View File

@ -0,0 +1,53 @@
c
c=======================================================================
c
c This version: Kevin Dunseath, 9 December 2019
c
subroutine diag_mat (n, a, lda, w, info)
c
use outunits_mod, only: iuo1
c
implicit none
c
integer, intent(in) :: n, lda
integer, intent(out) :: info
complex*16, intent(in) :: a(lda,*)
complex*16, intent(out) :: w(*)
c
c Local variables
c
integer :: lwork
complex*16 :: wquery
complex*16 :: vl(1,1), vr(1,1)
c
real*8, allocatable :: rwork(:)
complex*16, allocatable :: work(:)
c
c
info = 0
c
allocate(rwork(2*n))
c
c Get optimal workspace
c
lwork = -1
call zgeev('n','n',n,a,lda,w,vl,1,vr,1,wquery,lwork,rwork,info)
c
if (info.ne.0) then
write(iuo1,*) ' '
write(iuo1,*) ' ---> work(1),info =',wquery,info
write(iuo1,*) ' '
end if
c
lwork = int(wquery)
allocate(work(lwork))
c
call zgeev('n','n',n,a,lda,w,vl,1,vr,1,work,lwork,rwork,info)
c
deallocate(work,rwork)
c
return
end subroutine diag_mat
c
c=======================================================================
c

80
src/msspec/spec/fortran/eig/common/eig_mat_ms.f
View File

@ -17,18 +17,22 @@ C
USE OUTFILES_MOD USE OUTFILES_MOD
USE OUTUNITS_MOD USE OUTUNITS_MOD
USE TRANS_MOD USE TRANS_MOD
CKMD
USE RENORM_MOD
CKMD
C C
C! PARAMETER(NLTWO=2*NL_M) !Moved to DIM_MOD C! PARAMETER(NLTWO=2*NL_M) !Moved to DIM_MOD
C C
CHARACTER*24 OUTFILE,PATH CHARACTER*24 OUTFILE,PATH
C C
COMPLEX*16 HL1(0:NLTWO),SM(LINMAX*NATCLU_M,LINMAX*NATCLU_M) COMPLEX*16 HL1(0:NLTWO),SM(LINMAX*NATCLU_M,LINMAX*NATCLU_M)
COMPLEX*16 SUM_L,IC,ZEROC,WORK(32*LINMAX*NATCLU_M) CKMD COMPLEX*16 SUM_L,IC,ZEROC,WORK(32*LINMAX*NATCLU_M)
COMPLEX*16 SUM_L,IC,ZEROC
COMPLEX*16 YLM(0:NLTWO,-NLTWO:NLTWO),TLK,EXPKJ COMPLEX*16 YLM(0:NLTWO,-NLTWO:NLTWO),TLK,EXPKJ
COMPLEX*16 W(LINMAX*NATCLU_M) COMPLEX*16 W(LINMAX*NATCLU_M)
COMPLEX*16 VL(1,1),VR(1,1) CKMD COMPLEX*16 VL(1,1),VR(1,1)
C C
DOUBLE PRECISION RWORK(2*LINMAX*NATCLU_M) CKMD DOUBLE PRECISION RWORK(2*LINMAX*NATCLU_M)
C C
REAL*8 PI,ATTKJ,GNT(0:N_GAUNT),XKJ,YKJ,ZKJ,RKJ,ZDKJ,KRKJ REAL*8 PI,ATTKJ,GNT(0:N_GAUNT),XKJ,YKJ,ZKJ,RKJ,ZDKJ,KRKJ
C C
@ -64,6 +68,8 @@ C
C Construction of the multiple scattering kernel matrix G_o T. C Construction of the multiple scattering kernel matrix G_o T.
C Elements are stored using a linear index LINJ C Elements are stored using a linear index LINJ
C representing (J,LJ) C representing (J,LJ)
CKMD
SM = CMPLX(0.0D0, 0.0D0)
C C
JLIN=0 JLIN=0
DO JTYP=1,N_PROT DO JTYP=1,N_PROT
@ -139,16 +145,33 @@ C
ENDDO ENDDO
C C
N_DIM=LINMAX*NATCLU_M N_DIM=LINMAX*NATCLU_M
C
IF (I_REN.gt.0) THEN
C
CKMD Renormalize the matrix SM
C
CALL RENORM_MATRIX(JLIN,SM,N_DIM)
C
CKMD SM now contains the renormalized matrix
C
END IF
C C
C Eigenvalues of the kernel multiple scattering matrix SM C Eigenvalues of the kernel multiple scattering matrix SM
C C
CALL ZGEEV('N','N',JLIN,SM,N_DIM,W,VL,1,VR,1,WORK,34*N_DIM,RWORK, CKMDC CALL ZGEEV('N','N',JLIN,SM,N_DIM,W,VL,1,VR,1,WORK,32*N_DIM,RWORK,
&INFO) CKMD LWORK = 32*N_DIM
IF(INFO.NE.0) THEN CKMD CALL ZGEEV('N','N',JLIN,SM,N_DIM,W,VL,1,VR,1,WORK,LWORK,
WRITE(IUO1,*) ' ' CKMD &RWORK,INFO)
WRITE(IUO1,*) ' ---> WORK(1),INFO =',WORK(1),INFO CKMD
WRITE(IUO1,*) ' ' CALL DIAG_MAT(JLIN,SM,N_DIM,W,INFO)
ENDIF CKMD
CKMD SM has been overwritten here
C
CKMD IF(INFO.NE.0) THEN
CKMD WRITE(IUO1,*) ' '
CKMD WRITE(IUO1,*) ' ---> WORK(1),INFO =',WORK(1),INFO
CKMD WRITE(IUO1,*) ' '
CKMD ENDIF
C C
N_EIG=0 N_EIG=0
C C
@ -182,6 +205,10 @@ C
CALL ORDRE(JLIN,W1,NFIN,W2) CALL ORDRE(JLIN,W1,NFIN,W2)
C C
C C
CKMD
WRITE(IUO1,10)
WRITE(IUO1,12) JLIN
CKMD
WRITE(IUO1,10) WRITE(IUO1,10)
WRITE(IUO1,10) WRITE(IUO1,10)
WRITE(IUO1,15) W2(1) WRITE(IUO1,15) W2(1)
@ -213,8 +240,19 @@ C
ENDDO ENDDO
WRITE(IUO1,10) WRITE(IUO1,10)
WRITE(IUO1,10) WRITE(IUO1,10)
WRITE(IUO1,45) W2(1) CKMD
WRITE(IUO2,*) E_KIN,W2(1) IF (I_REN.NE.0) THEN
WRITE(IUO1,46) REN_R, REN_I
WRITE(IUO1,47) W2(1)
ELSE
WRITE(IUO1,45) W2(1)
ENDIF
CKMD
IF (I_REN.NE.0) THEN
WRITE(IUO2,*) E_KIN,W2(1),REN_R,REN_I
ELSE
WRITE(IUO2,*) E_KIN,W2(1)
ENDIF
IF(N_EIG.EQ.0) THEN IF(N_EIG.EQ.0) THEN
WRITE(IUO1,50) WRITE(IUO1,50)
ELSE ELSE
@ -226,9 +264,13 @@ C
C C
RETURN RETURN
C C
5 FORMAT(/,11X,'----------------- EIGENVALUE ANALYSIS ','--------- CKMD
&--------') 5 FORMAT(/,11X,'----------------- EIGENVALUE ANALYSIS ',
&'-----------------')
10 FORMAT(11X,'-',54X,'-') 10 FORMAT(11X,'-',54X,'-')
CKMD
12 FORMAT(11X,'-',14X,'MATRIX DIMENSION : ',I8,13X,'-')
CKMD
15 FORMAT(11X,'-',14X,'MAXIMUM MODULUS : ',F9.6,13X,'-') 15 FORMAT(11X,'-',14X,'MAXIMUM MODULUS : ',F9.6,13X,'-')
20 FORMAT(11X,'-',14X,'MINIMUM MODULUS : ',F9.6,13X,'-') 20 FORMAT(11X,'-',14X,'MINIMUM MODULUS : ',F9.6,13X,'-')
25 FORMAT(11X,'-',6X,'1 EIGENVALUE IS > 1 ON A TOTAL OF ',I8,6X,'-') 25 FORMAT(11X,'-',6X,'1 EIGENVALUE IS > 1 ON A TOTAL OF ',I8,6X,'-')
@ -238,12 +280,18 @@ C
40 FORMAT(11X,'-',6X,F7.4,2X,F7.4,2X,F7.4,2X,F7.4,2X,F7.4,5X,'-') 40 FORMAT(11X,'-',6X,F7.4,2X,F7.4,2X,F7.4,2X,F7.4,2X,F7.4,5X,'-')
45 FORMAT(11X,'-',5X,'SPECTRAL RADIUS OF THE KERNEL MATRIX :',F6.3, 45 FORMAT(11X,'-',5X,'SPECTRAL RADIUS OF THE KERNEL MATRIX :',F6.3,
&5X,'-') &5X,'-')
CKMD
46 FORMAT(11X,'-',16X,'OMEGA = (',F6.3,',',F6.3,')',15X,'-')
47 FORMAT(11X,'-',2X,'SPECTRAL RADIUS OF THE RENORMALIZED MATRIX: ',
&F6.3,2X,'-')
CKMD
50 FORMAT(11X,'-',5X,'---> THE MULTIPLE SCATTERING SERIES ', 50 FORMAT(11X,'-',5X,'---> THE MULTIPLE SCATTERING SERIES ',
&'CONVERGES',4X,'-') &'CONVERGES',4X,'-')
55 FORMAT(11X,'-',10X,'---> NO CONVERGENCE OF THE MULTIPLE',9X,'-',/ 55 FORMAT(11X,'-',10X,'---> NO CONVERGENCE OF THE MULTIPLE',9X,'-',/
&,11X,'-',18X,'SCATTERING SERIES',19X,'-') &,11X,'-',18X,'SCATTERING SERIES',19X,'-')
60 FORMAT(11X,'----------------------------------------','---------- CKMD
&------',/) 60 FORMAT(11X,'----------------------------------------',
&'----------------',/)
65 FORMAT(11X,'-',5X,' LABEL OF LARGEST EIGENVALUE : ',I5,8X,'- 65 FORMAT(11X,'-',5X,' LABEL OF LARGEST EIGENVALUE : ',I5,8X,'-
&') &')
70 FORMAT(11X,'-',5X,' LARGEST EIGENVALUE : ','(',F6.3,',',F6.3, 70 FORMAT(11X,'-',5X,' LARGEST EIGENVALUE : ','(',F6.3,',',F6.3,

140
src/msspec/spec/fortran/eig/common/renormalization.f Normal file
View File

@ -0,0 +1,140 @@
c
c=======================================================================
c
subroutine renorm_matrix (n, a, lda)
c
c This subroutine computes the renormalized matrices square matrices
c B_n : G_n, Sigma_n, Z_n, Pi_1.
c
c The general renormalization scheme is given by:
c
c (I - A)^{-1} = (I - M)^{-1} N
c
c where matrix N is given by:
c
c I_REN = 1 : N = REN2 * I with REN2 = REN**N_REN
c = 2 : N = REN2 * I with REN2 = (ONEC-REN**(N_REN+1))/(DFLOAT(N_REN+1)*(ONEC-REN))
c = 3 : N = REN2 * I with REN2 = -(REN-ONEC)**(N_REN+1)
c = 4 : N = I + REN * A
c
c
c Input parameters:
c
c * N : size of A
c * A : original matrix
c * A2 : A * A
c
c Input parameters:
c
c * A : renormalized matrix
c
c
c COMMON /RENORM/:
c
c I_REN = 1 : renormalization in terms of the B_n = G_n matrices (n : N_REN)
c = 2 : renormalization in terms of the B_n = Sigma_n matrices
c = 3 : renormalization in terms of the B_n = Z_n matrices
c = 4 : renormalization in terms of the B_n = Pi_1 matrix
c
c N_REN = n
c
c REN = REN_R+IC*REN_I
c
c
c Using the renormalization coefficient REN = REN_R + i REN_I, they
c are defined as
c
c I_REN = 1-3 : (I - A)^{-1} = REN2 * (I - B_n)^{-1}
c
c I_REN = 4 : (I - A)^{-1} = (I - B_n)^{-1} * (I + REN * A)
c
c which in turn implies
c
c I_REN = 1-3 : B_n = (1 - REN) * I + REN * A
c
c I_REN = 4 : B_n = I - (1 - REN) * A - REN * A2
c
c
c Author : D. Sébilleau
c
c Last modified : 23 Apr 2019
c
c This version: Kevin Dunseath, 9 December 2019
c
use renorm_mod, only: i_ren, n_ren, ren_r, ren_i
c
implicit none
c
integer, intent(in) :: n, lda
complex*16, intent(inout) :: a(lda,*)
c
c Local variables
c
complex*16, parameter :: zero = (0.0d0,0.0d0)
complex*16, parameter :: onec = (1.0d0,0.0d0)
complex*16, parameter :: ic = (0.0d0,1.0d0)
c
integer :: i, j
complex*16 :: ren, ren2
c
complex*16, allocatable :: a2(:,:)
c
c
ren = dble(ren_r) + ic*dble(ren_i)
c
c Computing the modified renormalization parameter REN2 (g_n,s_n,zeta_n)
c
select case (i_ren)
case (1)
c
c.....(g_n,G_n) renormalization: g_n = omega^n
c
ren2 = ren**n_ren
c
case (2)
c
c.....(s_{n},Sigma_n) renormalization:
c
if (abs(onec-ren).lt.1.0d-10) then
ren2 = onec
else
ren2 = (onec-ren**(n_ren+1))/(dfloat(n_ren+1)*(onec-ren))
end if
c
case (3)
c
c.....(zeta_{n},Z_n) renormalization
c
ren2 = -(ren-onec)**(n_ren+1)
c
case (4)
c
ren2 = ren
c
end select
c
c Calculation of the renormalized matrix
c
if (i_ren.le.3) then
do j=1,n
do i=1,n
a(i,j) = ren2*a(i,j)
end do
a(j,j) = a(j,j) + (onec-ren2)
end do
else if (i_ren.eq.4) then
allocate(a2(n,n))
call zgemm('n','n',n,n,n,onec,a,lda,a,lda,zero,a2,n)
do j=1,n
do i=1,n
a(i,j) = (onec-ren2)*a(i,j) + ren2*a2(i,j)
end do
end do
deallocate(a2)
end if
c
return
end
c
c=======================================================================
c

119
src/msspec/spec/fortran/eig/mi/do_main.f
View File

@ -392,7 +392,7 @@ C
READ(IRD2,117) LE_MIN1,N_CHANNEL READ(IRD2,117) LE_MIN1,N_CHANNEL
LE_MAX1=LE_MIN1+N_CHANNEL-1 LE_MAX1=LE_MIN1+N_CHANNEL-1
IF(I_TEST_A.NE.1) THEN IF(I_TEST_A.NE.1) THEN
IF((LE_MIN.NE.LE_MIN1).OR.(LE_MAX.NE.LE_MAX1)) GOTO IF((LE_MIN.NE.LE_MIN1).OR.(LE_MAX.NE.LE_MAX1)) GOTO
& 610 & 610
ELSE ELSE
LI_C2=0 LI_C2=0
@ -435,7 +435,7 @@ C
NAT2_A=NAT+NATA NAT2_A=NAT+NATA
NAT2=NAT2_A NAT2=NAT2_A
IF((NAT1_A.NE.NAT2_A).OR.(NE1_A.NE.NE_A)) GOTO 180 IF((NAT1_A.NE.NAT2_A).OR.(NE1_A.NE.NE_A)) GOTO 180
IF((ITL_A.EQ.0).AND.((NATR_A.NE.NAT2_A).OR.(NER_A.NE.NE))) IF((ITL_A.EQ.0).AND.((NATR_A.NE.NAT2_A).OR.(NER_A.NE.NE)))
& GOTO 182 & GOTO 182
C C
C.......... DL generated by MUFPOT and RHOR given .......... C.......... DL generated by MUFPOT and RHOR given ..........
@ -651,7 +651,7 @@ C
DIST12(JA1,JA2)=SQRT((COORD(1,JA1)-COORD(1,JA2))**2+( DIST12(JA1,JA2)=SQRT((COORD(1,JA1)-COORD(1,JA2))**2+(
& COORD(2,JA1)-COORD(2,JA2))**2+(COORD(3,JA1)-COORD(3,JA2))** & COORD(2,JA1)-COORD(2,JA2))**2+(COORD(3,JA1)-COORD(3,JA2))**
& 2) & 2)
IF((JA2.GT.JA1).AND.(DIST12(JA1,JA2).LT.0.001)) GOTO IF((JA2.GT.JA1).AND.(DIST12(JA1,JA2).LT.0.001)) GOTO
& 895 & 895
ENDDO ENDDO
ENDDO ENDDO
@ -1231,7 +1231,8 @@ c ENDIF
C C
C! IF((ISOM.NE.0).OR.(NFICHLEC.EQ.1)) CLOSE(IUO1) C! IF((ISOM.NE.0).OR.(NFICHLEC.EQ.1)) CLOSE(IUO1)
IF(ISOM.NE.0) CLOSE(IUO2) IF(ISOM.NE.0) CLOSE(IUO2)
STOP CKMD STOP
return
C C
1 WRITE(IUO1,60) 1 WRITE(IUO1,60)
STOP STOP
@ -1313,50 +1314,50 @@ C
29 FORMAT(/,20X,'THE Z POSITION OF PLANE ',I3,' IS : ',F6.3) 29 FORMAT(/,20X,'THE Z POSITION OF PLANE ',I3,' IS : ',F6.3)
30 FORMAT(///,23X,'THE ABSORBING ATOMS ARE OF TYPE :',/) 30 FORMAT(///,23X,'THE ABSORBING ATOMS ARE OF TYPE :',/)
31 FORMAT(38X,10(I2,3X),//) 31 FORMAT(38X,10(I2,3X),//)
34 FORMAT(//,2X,'PLANE No ',I3,3X,'THE ABSORBER OF TYPE ', I2,' IS 34 FORMAT(//,2X,'PLANE No ',I3,3X,'THE ABSORBER OF TYPE ', I2,' IS
&POSITIONED AT (',F7.3,',',F7.3,',',F7.3,')') &POSITIONED AT (',F7.3,',',F7.3,',',F7.3,')')
35 FORMAT(/////,'########## BEGINNING ', 'OF THE AZIMUTHAL 35 FORMAT(/////,'########## BEGINNING ', 'OF THE AZIMUTHAL
&PHOTOELECTRON DIFFRACTION CALCULATION #####', '#####',/////) &PHOTOELECTRON DIFFRACTION CALCULATION #####', '#####',/////)
36 FORMAT(/////,'########## BEGINNING ', 'OF THE 36 FORMAT(/////,'########## BEGINNING ', 'OF THE
&EXAFS CALCULATION ##########',/////) &EXAFS CALCULATION ##########',/////)
37 FORMAT(/////,'++++++++++++++++++++', ' NUMBERING OF THE 37 FORMAT(/////,'++++++++++++++++++++', ' NUMBERING OF THE
&ATOMS GENERATED +++++++++++++++++++') &ATOMS GENERATED +++++++++++++++++++')
38 FORMAT(///,30X,'TRANSLATION LEVEL : ',I2,///) 38 FORMAT(///,30X,'TRANSLATION LEVEL : ',I2,///)
39 FORMAT(///,'++++++++++++++++++++++++++++++++++++++++++++++++', 39 FORMAT(///,'++++++++++++++++++++++++++++++++++++++++++++++++',
& '++++++++++++++++++++++++++++++++',/////) & '++++++++++++++++++++++++++++++++',/////)
40 FORMAT(/////,'======================', ' CONTENTS OF THE 40 FORMAT(/////,'======================', ' CONTENTS OF THE
&REDUCED CLUSTER ======================',///) &REDUCED CLUSTER ======================',///)
41 FORMAT(///,'==================================================== 41 FORMAT(///,'====================================================
&','============================',/////) &','============================',/////)
43 FORMAT(14X,'TH_LIGHT = ',F6.2,' DEGREES',5X,'PHI_LIGHT = ',F6.2, 43 FORMAT(14X,'TH_LIGHT = ',F6.2,' DEGREES',5X,'PHI_LIGHT = ',F6.2,
&' DEGREES') &' DEGREES')
44 FORMAT(/////,'########## BEGINNING ', 'OF THE POLAR 44 FORMAT(/////,'########## BEGINNING ', 'OF THE POLAR
&PHOTOELECTRON DIFFRACTION CALCULATION #####', '#####',/////) &PHOTOELECTRON DIFFRACTION CALCULATION #####', '#####',/////)
45 FORMAT(14X,' (WHEN THE DETECTOR IS ALONG ','THE NORMAL TO THE 45 FORMAT(14X,' (WHEN THE DETECTOR IS ALONG ','THE NORMAL TO THE
&SURFACE)') &SURFACE)')
49 FORMAT(/////,'########## END OF THE ', 'POLAR PHOTOELECTRON 49 FORMAT(/////,'########## END OF THE ', 'POLAR PHOTOELECTRON
&DIFFRACTION CALCULATION ##########') &DIFFRACTION CALCULATION ##########')
50 FORMAT(///,22X,'THE CLUSTER IS COMPOSED OF ',I2,' PLANES :') 50 FORMAT(///,22X,'THE CLUSTER IS COMPOSED OF ',I2,' PLANES :')
51 FORMAT(/////,'########## END OF THE ', 'EXAFS 51 FORMAT(/////,'########## END OF THE ', 'EXAFS
&CALCULATION ##########') &CALCULATION ##########')
52 FORMAT(/////,'########## END OF THE ', 'AZIMUTHAL PHOTOELECTRON 52 FORMAT(/////,'########## END OF THE ', 'AZIMUTHAL PHOTOELECTRON
&DIFFRACTION CALCULATION #####','#####') &DIFFRACTION CALCULATION #####','#####')
57 FORMAT(///,27X,'CALCULATION OF THE SCATTERING FACTOR DONE') 57 FORMAT(///,27X,'CALCULATION OF THE SCATTERING FACTOR DONE')
58 FORMAT(/////,'########## BEGINNING ', 'OF THE FINE 58 FORMAT(/////,'########## BEGINNING ', 'OF THE FINE
&STRUCTURE OSCILLATIONS CALCULATION #####', '#####',/////) &STRUCTURE OSCILLATIONS CALCULATION #####', '#####',/////)
59 FORMAT(/////,'########## END OF THE ', 'FINE STRUCTURE 59 FORMAT(/////,'########## END OF THE ', 'FINE STRUCTURE
&OSCILLATIONS CALCULATION #####','#####') &OSCILLATIONS CALCULATION #####','#####')
60 FORMAT(///,'<<<<<<<<<< (NAT,NE,NEMET) > (NATP_M,NE_M,','NEMET_M) 60 FORMAT(///,'<<<<<<<<<< (NAT,NE,NEMET) > (NATP_M,NE_M,','NEMET_M)
& - CHECK THE DIMENSIONING >>>>>>>>>>') & - CHECK THE DIMENSIONING >>>>>>>>>>')
61 FORMAT(///,22X,' <<<<<<<<<< THIS STRUCTURE DOES NOT EXIST ', 61 FORMAT(///,22X,' <<<<<<<<<< THIS STRUCTURE DOES NOT EXIST ',
&' >>>>>>>>>>') &' >>>>>>>>>>')
64 FORMAT(///,4X,' <<<<<<<<<< NIV IS TOO SMALL, THE REDUCED ', 64 FORMAT(///,4X,' <<<<<<<<<< NIV IS TOO SMALL, THE REDUCED ',
&'CLUSTER HAS NOT CONVERGED YET >>>>>>>>>>') &'CLUSTER HAS NOT CONVERGED YET >>>>>>>>>>')
65 FORMAT(///,4X,' <<<<<<<<<< ONLY ONE OF THE VALUES IPHI,ITHETA ', 65 FORMAT(///,4X,' <<<<<<<<<< ONLY ONE OF THE VALUES IPHI,ITHETA ',
& 'ET IE CAN BE EQUAL TO 1 >>>>>>>>>>') & 'ET IE CAN BE EQUAL TO 1 >>>>>>>>>>')
75 FORMAT(///,8X,' <<<<<<<<<< CHANGE THE DIMENSIONING OF PCREL ', 75 FORMAT(///,8X,' <<<<<<<<<< CHANGE THE DIMENSIONING OF PCREL ',
& 'IN MAIN ET READ_DATA >>>>>>>>>>') & 'IN MAIN ET READ_DATA >>>>>>>>>>')
79 FORMAT(//,18X,'INITIAL STATE L = ',I1,5X,'FINAL STATES L = ', 79 FORMAT(//,18X,'INITIAL STATE L = ',I1,5X,'FINAL STATES L = ',
& I1,',',I1,/) & I1,',',I1,/)
80 FORMAT(15X,'(SPIN-ORBIT COMPONENT OF THE INITIAL CORE STATE : ', 80 FORMAT(15X,'(SPIN-ORBIT COMPONENT OF THE INITIAL CORE STATE : ',
&A3,')',//) &A3,')',//)
@ -1372,14 +1373,14 @@ C
90 FORMAT(////,31X,'POSITION OF THE LIGHT :',/) 90 FORMAT(////,31X,'POSITION OF THE LIGHT :',/)
91 FORMAT(24X,'+',35X,'+') 91 FORMAT(24X,'+',35X,'+')
92 FORMAT(24X,'+++++++++++++++++++++++++++++++++++++') 92 FORMAT(24X,'+++++++++++++++++++++++++++++++++++++')
94 FORMAT(//,2X,'PLANE No ',I3,3X,'NO ABSORBER OF TYPE ',I2, ' IS 94 FORMAT(//,2X,'PLANE No ',I3,3X,'NO ABSORBER OF TYPE ',I2, ' IS
&PRESENT IN THIS PLANE') &PRESENT IN THIS PLANE')
95 FORMAT(////,31X,'AUGER LINE :',A6,//) 95 FORMAT(////,31X,'AUGER LINE :',A6,//)
97 FORMAT(///,19X,'(PLANE WAVES MULTIPLE SCATTERING - ORDER ',I1,') 97 FORMAT(///,19X,'(PLANE WAVES MULTIPLE SCATTERING - ORDER ',I1,')
&') &')
98 FORMAT(///,17X,'(SPHERICAL WAVES MULTIPLE SCATTERING - ORDER ', 98 FORMAT(///,17X,'(SPHERICAL WAVES MULTIPLE SCATTERING - ORDER ',
&I1,')') &I1,')')
100 FORMAT(///,8X,'<<<<<<<<<< WRONG NAME FOR THE INITIAL STATE',' 100 FORMAT(///,8X,'<<<<<<<<<< WRONG NAME FOR THE INITIAL STATE','
&>>>>>>>>>>') &>>>>>>>>>>')
101 FORMAT(24X,I3,24X,I3) 101 FORMAT(24X,I3,24X,I3)
102 FORMAT(A1) 102 FORMAT(A1)
@ -1405,7 +1406,7 @@ C
&5,')') &5,')')
117 FORMAT(12X,I2,5X,I2) 117 FORMAT(12X,I2,5X,I2)
118 FORMAT(/,37X,'AUGER ELECTRON DIFFRACTION',/) 118 FORMAT(/,37X,'AUGER ELECTRON DIFFRACTION',/)
119 FORMAT(10X,'LE = ',I2,11X,'DIRECT INTEGRAL',8X,'EXCHANGE 119 FORMAT(10X,'LE = ',I2,11X,'DIRECT INTEGRAL',8X,'EXCHANGE
&INTEGRAL') &INTEGRAL')
120 FORMAT(///,15X,'(SPHERICAL WAVES MULTIPLE SCATTERING - MATRIX ', 120 FORMAT(///,15X,'(SPHERICAL WAVES MULTIPLE SCATTERING - MATRIX ',
&'INVERSION)') &'INVERSION)')
@ -1422,39 +1423,39 @@ C
&'AND RADIAL MATRIX ELEMENTS FILES >>>>>>>>>>') &'AND RADIAL MATRIX ELEMENTS FILES >>>>>>>>>>')
185 FORMAT(///,'<<<<<<<<<< LMAX > NL_M-1 IN THE PHASE SHIFTS ', 185 FORMAT(///,'<<<<<<<<<< LMAX > NL_M-1 IN THE PHASE SHIFTS ',
&'FILE >>>>>>>>>>') &'FILE >>>>>>>>>>')
234 FORMAT(' -----> TEST CALCULATION : NO EXCITATION ','MATRIX 234 FORMAT(' -----> TEST CALCULATION : NO EXCITATION ','MATRIX
&ELEMENTS TAKEN INTO ACCOUNT <-----',///) &ELEMENTS TAKEN INTO ACCOUNT <-----',///)
235 FORMAT(/////,'########## BEGINNING ', 'OF THE AZIMUTHAL 235 FORMAT(/////,'########## BEGINNING ', 'OF THE AZIMUTHAL
&AUGER DIFFRACTION CALCULATION #####', '#####',/////) &AUGER DIFFRACTION CALCULATION #####', '#####',/////)
236 FORMAT(/////,'########## BEGINNING ', 'OF THE AZIMUTHAL 236 FORMAT(/////,'########## BEGINNING ', 'OF THE AZIMUTHAL
&APECS DIFFRACTION CALCULATION #####', '#####',/////) &APECS DIFFRACTION CALCULATION #####', '#####',/////)
237 FORMAT(/////,'########## END ', 'OF THE AZIMUTHAL AUGER 237 FORMAT(/////,'########## END ', 'OF THE AZIMUTHAL AUGER
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
238 FORMAT(/////,6X,'########## END ', 'OF THE POLAR AUGER 238 FORMAT(/////,6X,'########## END ', 'OF THE POLAR AUGER
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
239 FORMAT(/////,'########## END ', 'OF THE AZIMUTHAL APECS 239 FORMAT(/////,'########## END ', 'OF THE AZIMUTHAL APECS
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
240 FORMAT(/////,6X,'########## END ', 'OF THE POLAR APECS 240 FORMAT(/////,6X,'########## END ', 'OF THE POLAR APECS
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
244 FORMAT(/////,6X,'########## BEGINNING ', 'OF THE POLAR AUGER 244 FORMAT(/////,6X,'########## BEGINNING ', 'OF THE POLAR AUGER
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
245 FORMAT(/////,6X,'########## BEGINNING ', 'OF THE POLAR APECS 245 FORMAT(/////,6X,'########## BEGINNING ', 'OF THE POLAR APECS
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
246 FORMAT(/////,'########## BEGINNING ', 'OF THE FULL ANGLE 246 FORMAT(/////,'########## BEGINNING ', 'OF THE FULL ANGLE
&PHOTOELECTRON DIFFRACTION CALCULATION ','##########',/////) &PHOTOELECTRON DIFFRACTION CALCULATION ','##########',/////)
247 FORMAT(/////,'########## BEGINNING ', 'OF THE FULL ANGLE 247 FORMAT(/////,'########## BEGINNING ', 'OF THE FULL ANGLE
&AUGER DIFFRACTION CALCULATION ', '##########',/////) &AUGER DIFFRACTION CALCULATION ', '##########',/////)
248 FORMAT(/////,'########## BEGINNING ', 'OF THE FULL ANGLE 248 FORMAT(/////,'########## BEGINNING ', 'OF THE FULL ANGLE
&APECS DIFFRACTION CALCULATION ', '##########',/////) &APECS DIFFRACTION CALCULATION ', '##########',/////)
249 FORMAT(/////,'########## END OF THE ', 'FULL ANGLE PHOTOELECTRON 249 FORMAT(/////,'########## END OF THE ', 'FULL ANGLE PHOTOELECTRON
&DIFFRACTION CALCULATION #####','#####') &DIFFRACTION CALCULATION #####','#####')
250 FORMAT(/////,'########## END ', 'OF THE FULL ANGLE AUGER 250 FORMAT(/////,'########## END ', 'OF THE FULL ANGLE AUGER
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
251 FORMAT(/////,'########## END ', 'OF THE FULL ANGLE APECS 251 FORMAT(/////,'########## END ', 'OF THE FULL ANGLE APECS
&DIFFRACTION CALCULATION #####', '#####',/////) &DIFFRACTION CALCULATION #####', '#####',/////)
252 FORMAT(/////,'########## BEGINNING ', 'OF THE MULTIPLE 252 FORMAT(/////,'########## BEGINNING ', 'OF THE MULTIPLE
&SCATTERING EIGENVALUE CALCULATION #####', '#####',/////) &SCATTERING EIGENVALUE CALCULATION #####', '#####',/////)
253 FORMAT(/////,'########## END ', 'OF THE MULTIPLE SCATTERING 253 FORMAT(/////,'########## END ', 'OF THE MULTIPLE SCATTERING
&EIGENVALUE CALCULATION #####', '#####',/////) &EIGENVALUE CALCULATION #####', '#####',/////)
334 FORMAT(24X,'+ COMPLEX POTENTIAL CALCULATION +') 334 FORMAT(24X,'+ COMPLEX POTENTIAL CALCULATION +')
335 FORMAT(24X,'+ STANDARD +') 335 FORMAT(24X,'+ STANDARD +')
@ -1472,19 +1473,19 @@ C
&',F8.5,',',F8.5,')',/,56X,'(',F8.5,',',F8.5,')') &',F8.5,',',F8.5,')',/,56X,'(',F8.5,',',F8.5,')')
445 FORMAT(12X,'PHASE SHIFT FOR THE ABSORBER OF TYPE ',I2,' : (',F8. 445 FORMAT(12X,'PHASE SHIFT FOR THE ABSORBER OF TYPE ',I2,' : (',F8.
&5,',',F8.5,')') &5,',',F8.5,')')
505 FORMAT(///,'<<<<<<<<<< LI IS LARGER THAN LI_M - ','CHECK THE 505 FORMAT(///,'<<<<<<<<<< LI IS LARGER THAN LI_M - ','CHECK THE
&DIMENSIONING >>>>>>>>>>') &DIMENSIONING >>>>>>>>>>')
511 FORMAT(///,'<<<<<<<<<< NATCLU_M IN THE .inc FILE IS NOT ', 511 FORMAT(///,'<<<<<<<<<< NATCLU_M IN THE .inc FILE IS NOT ',
&'CONSISTENT WITH THE NUMBER OF ATOMS READ FROM UNIT ',I2,' &'CONSISTENT WITH THE NUMBER OF ATOMS READ FROM UNIT ',I2,'
&>>>>>>>>>>') &>>>>>>>>>>')
515 FORMAT(///,'<<<<<<<<<< INCOMPATIBILITY BETWEEN THE VALUES OF ', 515 FORMAT(///,'<<<<<<<<<< INCOMPATIBILITY BETWEEN THE VALUES OF ',
&'NAT IN THE DATA AND CLUSTER FILES >>>>>>>>>>') &'NAT IN THE DATA AND CLUSTER FILES >>>>>>>>>>')
517 FORMAT(///,'<<<<<<<<<< THERE ARE MISSING VALUES FOR THFWD AND ', 517 FORMAT(///,'<<<<<<<<<< THERE ARE MISSING VALUES FOR THFWD AND ',
&'IBWD >>>>>>>>>>') &'IBWD >>>>>>>>>>')
519 FORMAT(///,'<<<<<<<<<< NATCLU_M IN THE .inc FILE IS NOT',' 519 FORMAT(///,'<<<<<<<<<< NATCLU_M IN THE .inc FILE IS NOT','
&CONSISTENT WITH THE NUMBER OF ATOMS GENERATED BY THE ','CODE &CONSISTENT WITH THE NUMBER OF ATOMS GENERATED BY THE ','CODE
&>>>>>>>>>>') &>>>>>>>>>>')
521 FORMAT(///,'<<<<<<<<<< SPIN-ORBIT COMPONENT NOT CONSISTENT 521 FORMAT(///,'<<<<<<<<<< SPIN-ORBIT COMPONENT NOT CONSISTENT
&WITH',' THE VALUE OF LI >>>>>>>>>>') &WITH',' THE VALUE OF LI >>>>>>>>>>')
530 FORMAT(3X,F9.4,3X,F9.4,3X,F9.4) 530 FORMAT(3X,F9.4,3X,F9.4,3X,F9.4)
535 FORMAT(29X,F8.5,1X,F8.5) 535 FORMAT(29X,F8.5,1X,F8.5)
@ -1502,29 +1503,29 @@ C
558 FORMAT(/////,18X,'CONTENTS OF THE CLUSTER READ FROM UNIT ',I2,' : 558 FORMAT(/////,18X,'CONTENTS OF THE CLUSTER READ FROM UNIT ',I2,' :
& ',/,20X,'READ IN ',A30,//,15X,'No',13X,'(X,Y,Z)',10X,'CLASS',1X, & ',/,20X,'READ IN ',A30,//,15X,'No',13X,'(X,Y,Z)',10X,'CLASS',1X,
&'ATOM',/) &'ATOM',/)
559 FORMAT(/////,25X,'CONTENTS OF THE CLUSTER GENERATED : ',//,14X,' 559 FORMAT(/////,25X,'CONTENTS OF THE CLUSTER GENERATED : ',//,14X,'
&No ',10X,'COORDINATES',9X,'TYPE',2X,'SNo',2X,'SYM',/) &No ',10X,'COORDINATES',9X,'TYPE',2X,'SNo',2X,'SYM',/)
560 FORMAT(////,12X,'MAXIMAL VALUES OF L FOR THE ',I3,' PROTOTYPICAL 560 FORMAT(////,12X,'MAXIMAL VALUES OF L FOR THE ',I3,' PROTOTYPICAL
&ATOMS : ',//) &ATOMS : ',//)
561 FORMAT(////,18X,'MAXIMAL VALUE OF L FOR THE ','PROTOTYPICAL ATOM 561 FORMAT(////,18X,'MAXIMAL VALUE OF L FOR THE ','PROTOTYPICAL ATOM
&: ',//) &: ',//)
562 FORMAT(///,'oooooooooooooooo',12X,'END OF THE INPUT DATA FILE', 562 FORMAT(///,'oooooooooooooooo',12X,'END OF THE INPUT DATA FILE',
&13X,'oooooooooooooooo',///) &13X,'oooooooooooooooo',///)
563 FORMAT(//,20X,'ENERGY POINT No ',I3,' :',/) 563 FORMAT(//,20X,'ENERGY POINT No ',I3,' :',/)
571 FORMAT(///,'<<<<<<<<<< THE NUMBER OF LINES ATBAS DOES NOT ', 571 FORMAT(///,'<<<<<<<<<< THE NUMBER OF LINES ATBAS DOES NOT ',
&'CORRESPOND TO NAT >>>>>>>>>>') &'CORRESPOND TO NAT >>>>>>>>>>')
581 FORMAT(///,'<<<<<<<<<< LI OR IMOD NOT CONSISTENT BETWEEN ','PHD 581 FORMAT(///,'<<<<<<<<<< LI OR IMOD NOT CONSISTENT BETWEEN ','PHD
&AND AED FOR COINCIDENCE CALCULATION >>>>>>>>>>') &AND AED FOR COINCIDENCE CALCULATION >>>>>>>>>>')
591 FORMAT(///,'<<<<<<<<<< THE EXTERNAL DIRECTIONS FILE IS ','NOT 591 FORMAT(///,'<<<<<<<<<< THE EXTERNAL DIRECTIONS FILE IS ','NOT
&CONSISTENT WITH THE INPUT DATA FILE >>>>>>>>>>') &CONSISTENT WITH THE INPUT DATA FILE >>>>>>>>>>')
601 FORMAT(///,'<<<<<<<<<< NO_ST_M IS TOO SMALL IN THE .inc FILE ', 601 FORMAT(///,'<<<<<<<<<< NO_ST_M IS TOO SMALL IN THE .inc FILE ',
&'>>>>>>>>>>',//) &'>>>>>>>>>>',//)
603 FORMAT(///,'<<<<<<<<<< NSPIN_M OR NSPIN2_M IS TOO SMALL IN THE 603 FORMAT(///,'<<<<<<<<<< NSPIN_M OR NSPIN2_M IS TOO SMALL IN THE
&','.inc FILE >>>>>>>>>>',//) &','.inc FILE >>>>>>>>>>',//)
605 FORMAT(///,'<<<<<<<<<< NT_M IS TOO SMALL IN THE .inc FILE ', 605 FORMAT(///,'<<<<<<<<<< NT_M IS TOO SMALL IN THE .inc FILE ',
&'>>>>>>>>>>',//) &'>>>>>>>>>>',//)
607 FORMAT(///,'<<<<<<<<<< THE INITIAL STATE LI IN THE INPUT DATA 607 FORMAT(///,'<<<<<<<<<< THE INITIAL STATE LI IN THE INPUT DATA
&','FILE IS DIFFERENT FROM THAT IN THE RADIAL MATRIX ','ELEMENTS &','FILE IS DIFFERENT FROM THAT IN THE RADIAL MATRIX ','ELEMENTS
&FILE >>>>>>>>>>',//) &FILE >>>>>>>>>>',//)
609 FORMAT(///,'<<<<<<<<<< THE TWO TL FILE ARE NOT COMPATIBLE ', 609 FORMAT(///,'<<<<<<<<<< THE TWO TL FILE ARE NOT COMPATIBLE ',
&'>>>>>>>>>>',//) &'>>>>>>>>>>',//)
@ -1537,21 +1538,21 @@ C
&'THE DIMENSIONNING FILE >>>>>>>>>>',//) &'THE DIMENSIONNING FILE >>>>>>>>>>',//)
621 FORMAT(///,'<<<<<<<<<< LI_M SHOULD BE AT LEAST ',I3,' IN ', 621 FORMAT(///,'<<<<<<<<<< LI_M SHOULD BE AT LEAST ',I3,' IN ',
&'THE DIMENSIONNING FILE >>>>>>>>>>',//) &'THE DIMENSIONNING FILE >>>>>>>>>>',//)
631 FORMAT(///,'<<<<<<<<<< EXCURSIONS OF ANGLES SHOULD ',' BE 631 FORMAT(///,'<<<<<<<<<< EXCURSIONS OF ANGLES SHOULD ',' BE
&IDENTICAL >>>>>>>>>>',/,'<<<<<<<<<< ','FOR BOTH &IDENTICAL >>>>>>>>>>',/,'<<<<<<<<<< ','FOR BOTH
&ELECTRONS IN CLUSTER ROTATION MODE',' >>>>>>>>>>',//) &ELECTRONS IN CLUSTER ROTATION MODE',' >>>>>>>>>>',//)
776 FORMAT(I2) 776 FORMAT(I2)
777 FORMAT(A24) 777 FORMAT(A24)
778 FORMAT(30X,I1) 778 FORMAT(30X,I1)
779 FORMAT(11X,A2,5X,I2,3F10.4,I5) 779 FORMAT(11X,A2,5X,I2,3F10.4,I5)
782 FORMAT(/////,22X,'THE CLUSTER GENERATED CONSISTS OF : ',I4,' 782 FORMAT(/////,22X,'THE CLUSTER GENERATED CONSISTS OF : ',I4,'
&ATOMS') &ATOMS')
889 FORMAT(/////,'<<<<<<<<<< DECREASE NIV OR INCREASE',' NATCLU_M 889 FORMAT(/////,'<<<<<<<<<< DECREASE NIV OR INCREASE',' NATCLU_M
&>>>>>>>>>>') &>>>>>>>>>>')
891 FORMAT(/////,'<<<<<<<<<< WRONG NAME FOR THE COORDINATES ''', 891 FORMAT(/////,'<<<<<<<<<< WRONG NAME FOR THE COORDINATES ''',
&'UNITS >>>>>>>>>>') &'UNITS >>>>>>>>>>')
896 FORMAT(///,10X,'<<<<<<<<<< ERROR IN THE COORDINATES OF THE',' 896 FORMAT(///,10X,'<<<<<<<<<< ERROR IN THE COORDINATES OF THE','
&ATOMS >>>>>>>>>>',/,10X,'<<<<<<<<<< ATOMS ',I4,' AND ',I4,' &ATOMS >>>>>>>>>>',/,10X,'<<<<<<<<<< ATOMS ',I4,' AND ',I4,'
&ARE IDENTICAL >>>>>>>>>>') &ARE IDENTICAL >>>>>>>>>>')
C C
END END