| 查看: 801 | 回复: 0 | |||
rlafite木虫 (正式写手)
|
[求助]
这段F90代码如何用OpenMP并行运算？
|
|
这段代码如何用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 ! |
回复此楼» 本帖附件资源列表
-
欢迎监督和反馈：小木虫仅提供交流平台，不对该内容负责。
本内容由用户自主发布，如果其内容涉及到知识产权问题，其责任在于用户本人，如对版权有异议，请联系邮箱：xiaomuchong@tal.com - 附件 1 : rabs_auger.f90
2019-05-04 05:23:07, 86.51 K
» 猜你喜欢
0857 资源与环境 285分
已经有3人回复
-
标题:捡漏预警|08工科/09农学调剂!英语要求低，过线即有机会!
已经有12人回复
-
一志愿安徽大学材料工程专硕313分，求调剂的学校
已经有8人回复
-
313求调剂
已经有4人回复
-
083000环境科学与工程调剂
已经有8人回复
-
材料调剂，307分
已经有12人回复
-
售SCI一区T0P文章，我:8.O.5.5.1.O.5.4,科目齐全,可+急
已经有4人回复
-
070300化学 280 一志愿太原理工 求调剂
已经有9人回复
-
一志愿北京化工大学材料与化工296分求调剂
已经有12人回复
-
哈工大材料324求调剂
已经有8人回复
