46 lines
1.2 KiB
Fortran
46 lines
1.2 KiB
Fortran
SUBROUTINE SGMER0
|
|
C =================
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
PARAMETER (FRH=3.28805E15, PH2=2.815D29*2., EHB=157802.77355)
|
|
DIMENSION FREDG(NLMX),S(NLMX),SUM(NLMX),SUD(NLMX)
|
|
C
|
|
IMER=0
|
|
DO 100 II=1,NLEVEL
|
|
IF(IFWOP(II).GE.0) GO TO 100
|
|
IMER=IMER+1
|
|
IMRG(II)=IMER
|
|
IIMER(IMER)=II
|
|
IE=IEL(II)
|
|
CH=IZ(IE)*IZ(IE)
|
|
FRCH(IMER)=FRH*CH
|
|
SGM0(IMER)=PH2*CH*CH
|
|
II0=NQUANT(II-1)+1
|
|
DO ID=1,ND
|
|
EX=EHB*CH*TEMP1(ID)
|
|
DO I=II0,NLMX
|
|
FREDG(I)=FRCH(IMER)*XI2(I)
|
|
EXI=EXP(EX*XI2(I))
|
|
S(I)=EXI*WNHINT(I,ID)*XI3(I)
|
|
SUM(I)=0.
|
|
END DO
|
|
SUM(NLMX)=S(NLMX)
|
|
SUD(NLMX)=S(NLMX)*XI2(NLMX)
|
|
DO I=NLMX-1,II0,-1
|
|
SUM(I)=SUM(I+1)+S(I)
|
|
END DO
|
|
DO I=1,II0-1
|
|
SUM(I)=SUM(II0)
|
|
END DO
|
|
SGEM=SGM0(IMER)/GMER(IMER,ID)
|
|
DO I=1,NLMX
|
|
SGMSUM(I,IMER,ID)=SUM(I)*SGEM
|
|
END DO
|
|
END DO
|
|
100 CONTINUE
|
|
RETURN
|
|
END
|