这段代码如何用openmp并行运算?(附件是全模块) 并保证不溢出16gb内存
全套程序下载地址如下:
http://www.atomic-theory.uni-jen ... ange/ratip-2012.tgz
subroutine auger_calculate_amplitudes()
!--------------------------------------------------------------------
! calculates for all transitions in turn the required continuum
! spinors and auger amplitudes.
!
! calls: add_csf_to_basis(), anco_calculate_csf_matrix(),
! auger_channel_amplitude(), auger_pure_matrix(),
! auger_transition_properties() cowf_iterate_csp(),
! cowf_set_xk_coefficients(), cowf_set_yk_coefficients(),
! print_configuration_scheme()
! set_configuration_scheme().
!--------------------------------------------------------------------
!
integer :: i, j, n, nw, nocsf
real(kind=dp) :: energy
type(nkappa) :: subshell
integer, dimension(, allocatable :: ndx
!
n = asf_final%csf_set%nocsf + asf_initial%csf_set%nocsf
!
! allocate for a "first time"; it is first dellocated before any usage
allocate( auger_csp%p(1:n_grasp92), auger_csp%q(1:n_grasp92) )
allocate( cowf_csp%p(1:10), cowf_csp%q(1:10) )
allocate( ndx(1:n) )
do i = 1,number_of_transitions
if (transition(i)%energy < zero) then
transition(i)%probability = zero
transition(i)%alpha_2 = zero
transition(i)%alpha_4 = zero
transition(i)%eta_2 = zero
transition(i)%eta_4 = zero
cycle
end if
!
do j = 1,transition(i)%number_of_channels
energy = transition(i)%energy
!!x print *, "auger_calculate_amplitudes - a"
call set_configuration_scheme(asf_final%csf_set,asf_cont%csf_set,&
-1,transition(i)%channel(j)%kappa, &
transition(i)%totalj_f,transition(i)%parity_f, &
transition(i)%totalj_i,transition(i)%parity_i, &
append=.false.,index=ndx)
!
auger%no_f = asf_cont%csf_set%nocsf
allocate( auger%ndx_f(auger%no_f) )
auger%ndx_f(1:auger%no_f) = ndx(1:auger%no_f)
!
nw = asf_cont%csf_set%nwshells
if (rabs_use_stop .and. nw /= asf_final%csf_set%nwshells + 1) then
stop "auger_calculate_amplitudes(): program stop a."
end if
! calculate the mcp coefficients for the current coupling scheme
! as well as the d_rs, y_k(ab), and x_k(abcd) coefficients
nocsf = asf_cont%csf_set%nocsf
call anco_calculate_csf_matrix(asf_cont%csf_set,1,nocsf,1,nocsf)
call cowf_set_drs_coefficients(transition(i)%asff, &
asf_cont%csf_set,ndx)
subshell = nkappa(-1,transition(i)%channel(j)%kappa)
call cowf_set_yk_coefficients(subshell,asf_cont%csf_set)
!!x print *, "auger_calculate_amplitudes - f"
call cowf_set_xk_coefficients(subshell,asf_cont%csf_set)
!!x print *, "auger_calculate_amplitudes - g"
!
! now iterate the continuum spinors for this channel
! cowf_solve_homogeneous_eqn = .true.
cowf_start_homogeneous = .true.
cowf_phaseshift_wkb = .true.
cowf_phaseshift_zero_potential = .false.
cowf_phaseshift_coulomb = .false.
!
!! cowf_norm_nonrel = .true.
cowf_norm_wkb = .true.
call cowf_iterate_csp(energy,subshell)
!
auger_csp = cowf_csp
transition(i)%channel(j)%phase = auger_csp%phase
!
! define the 'extended' configuration scheme for calculating
! the auger matrix and allocate memory
call add_csf_to_basis(asf_initial%csf_set,asf_cont%csf_set, &
transition(i)%totalj_i,transition(i)%parity_i,index=ndx)
if (auger_print_csf_scheme) then
call print_configuration_scheme(6,asf_cont%csf_set)
end if
!
auger%no_i = asf_cont%csf_set%nocsf - auger%no_f
allocate( auger%ndx_i(auger%no_i) )
auger%ndx_i(1:auger%no_i) = ndx(1+auger%no_f:asf_cont%csf_set%nocsf)
allocate( auger%matrix(1:auger%no_f,1:auger%no_i) )
!
! calculate the 'pure' auger matrix in the given csf scheme
! (not including mixing coefficients)
call auger_pure_matrix(asf_cont%csf_set,i)
!
call auger_channel_amplitude(i,j)
!
deallocate( auger%ndx_f, auger%ndx_i, auger%matrix )
call deallocate_csf_basis(asf_cont%csf_set)
end do
!
! calculates all selected properties for the selected transition
call auger_transition_properties(transition(i))
end do
deallocate( ndx, auger_csp%p, auger_csp%q)
!
end subroutine auger_calculate_amplitudes
!
!
subroutine auger_channel_amplitude(i,j)
!--------------------------------------------------------------------
! calculates the auger amplitude of channel j of transition i
! by summing over the 'pure' auger matrix using the proper weights of
! transition i.
!
! calls:
!--------------------------------------------------------------------
!
integer, intent(in) :: i, j
!
integer :: asfi, asff, l, r, rr, s, ss
real(kind=dp) :: phase, value
!
if (auger_print_main_csf_me) then
print *, " "
print *, "main contribution from initial- and final-state csf "// &
"(abs(c_i*c_f) > 0.01)"
print *, "----------------------------------------------------"// &
"---------------------"
print *, " "
print *, " i-csf f-csf kappa c_i c_f c_i*c_f"//&
" c_i*c_f*a_if "
print *, "-------------------------------------------------------"//&
"-----------------"
end if
!
asfi = transition(i)%asfi; asff = transition(i)%asff
value = zero
do r = 1,auger%no_f
rr = auger%ndx_f(r)
do s = 1,auger%no_i
ss = auger%ndx_i(s)
value = value + asf_final%asf(asff)%eigenvector(rr) * &
auger%matrix(r,s) * asf_initial%asf(asfi)%eigenvector(ss)
!
if (auger_print_main_csf_me) then
if (abs(asf_final%asf(asff)%eigenvector(rr)* &
asf_initial%asf(asfi)%eigenvector(ss)) > 0.01_dp .and.&
abs(asf_final%asf(asff)%eigenvector(rr) * &
auger%matrix(r,s) * &
asf_initial%asf(asfi)%eigenvector(ss)) > 0.000001_dp) then
!
! determine first the radial integrals from the occupation
! of the csf
write(*,1) ss,rr, &
orbital_symmetry(transition(i)%channel(j)%kappa), &
asf_initial%asf(asfi)%eigenvector(ss), &
asf_final%asf(asff)%eigenvector(rr), &
asf_final%asf(asff)%eigenvector(rr)* &
asf_initial%asf(asfi)%eigenvector(ss), &
asf_final%asf(asff)%eigenvector(rr)* &
asf_initial%asf(asfi)%eigenvector(ss)* &
auger%matrix(r,s)
1 format(1x,i7,i10,6x,a2,3x,f6.3,2x,f6.3,5x,f8.5,4x,f9.6)
end if
end if
!
end do
end do
!
if (auger_print_main_csf_me) then
print *, "-------------------------------------------------------"//&
"-----------------"
end if
!
l = angular_momentum_l(transition(i)%channel(j)%kappa)
phase = transition(i)%channel(j)%phase
!
transition(i)%channel(j)%amplitude_re = value
transition(i)%channel(j)%amplitude = cmplx(zero,one)**l * &
exp( -cmplx(zero,one)*phase) * cmplx(value,zero)
!
print *, "i,j,transition(i)%channel(j)%amplitude = ", &
i,j,transition(i)%channel(j)%amplitude
!
end subroutine auger_channel_amplitude
! |