 |
 |
 |
 |
 |
 |
||
 |
 |
 |
 |
 |
| 1 | 1/1 | 返回列表 |
| 查看: 798 | 回復(fù): 0 | ||
rlafite木蟲 (正式寫手)
|
[求助]
這段F90代碼如何用OpenMP并行運算？
|
|
這段代碼如何用openmp并行運算？(附件是全模塊) 并保證不溢出16gb內(nèi)存 全套程序下載地址如下: 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 ! |
回復(fù)此樓» 本帖附件資源列表
-
歡迎監(jiān)督和反饋：小木蟲僅提供交流平臺，不對該內(nèi)容負責(zé)。
本內(nèi)容由用戶自主發(fā)布，如果其內(nèi)容涉及到知識產(chǎn)權(quán)問題，其責(zé)任在于用戶本人，如對版權(quán)有異議，請聯(lián)系郵箱：xiaomuchong@tal.com - 附件 1 : rabs_auger.f90
2019-05-04 05:23:07, 86.51 K
» 猜你喜歡
282求調(diào)劑
已經(jīng)有6人回復(fù)
-
271求調(diào)劑
已經(jīng)有7人回復(fù)
-
【求調(diào)劑】293分環(huán)境工程求調(diào)劑材料/化工，服從調(diào)劑，抗壓能力強！
已經(jīng)有7人回復(fù)
-
085600材料與化工，一志愿廣州985，求調(diào)劑
已經(jīng)有6人回復(fù)
-
求材料調(diào)劑
已經(jīng)有4人回復(fù)
-
復(fù)試調(diào)劑
已經(jīng)有5人回復(fù)
-
085600，一志愿鄭州大學(xué)，280分求調(diào)劑
已經(jīng)有3人回復(fù)
-
085602 293分求調(diào)劑
已經(jīng)有3人回復(fù)
-
A區(qū)一本交叉課題組，低分調(diào)劑，招收機械電子信息通信等交叉方向
已經(jīng)有24人回復(fù)
-
材料調(diào)劑
已經(jīng)有4人回復(fù)
相關(guān)版塊跳轉(zhuǎn)
我要訂閱樓主 rlafite 的主題更新
| 1 | 1/1 | 返回列表 |
| 最具人氣熱帖推薦 [查看全部] | 作者 | 回/看 | 最后發(fā)表 | |
|---|---|---|---|---|
|
[考研] 求調(diào)劑 +3 | danyyyy 2026-03-04 | 3/150 |
|
|---|---|---|---|---|
|
[考研] 歡迎211本科同學(xué)，過A區(qū)國家線，A區(qū)非偏遠一本，交叉學(xué)科課題組 +11 | lisimayy 2026-03-04 | 21/1050 |
|
|
|
[基金申請]
 本子寫完了，給DS兄弟看了，得了92分
+6
|
Doma 2026-03-01 | 10/500 |
|
|
|
[考研] 考研282分求調(diào)劑，接受跨專業(yè) +4 | 劉淄博 2026-03-04 | 6/300 |
|
|
|
[考研] 22408-273求調(diào)劑-擔(dān)任3個項目的負責(zé)人-1篇國際期刊論文（一作）1篇核心期刊論文在投。 +3 | 沒想好取什么名 2026-03-03 | 3/150 |
|
|
|
[考研] 材料復(fù)試調(diào)劑 +7 | 學(xué)材料的點 2026-03-01 | 8/400 |
|
|
|
[考研] 一志愿985材料與化工 326分求調(diào)劑 +3 | Hz795795 2026-03-04 | 3/150 |
|
|
|
[考研] 274求調(diào)劑 +8 | 一個學(xué)習(xí)者 2026-03-04 | 8/400 |
|
|
|
[考研] 一志愿鄭州大學(xué)，學(xué)碩，物理化學(xué)， 333求調(diào)劑 +5 | 李魔女斗篷 2026-03-04 | 5/250 |
|
|
|
[考研] 一志愿314求調(diào)劑 +7 | 202111120625 2026-03-03 | 7/350 |
|
|
|
[考研] 325求調(diào)劑 +5 | 學(xué)家科 2026-03-04 | 5/250 |
|
|
|
[考研] 085601 材料305分求助 +4 | 泡泡郵件 2026-03-03 | 6/300 |
|
|
|
[考研] 293求調(diào)劑 +4 | 是樂渝哇 2026-03-03 | 4/200 |
|
|
|
[考研] 284求調(diào)劑 +6 | 天下熯 2026-03-02 | 6/300 |
|
|
|
[考研] 化學(xué)0703求調(diào)劑 學(xué)碩 理/工科均可 總分279 +3 | 1一11 2026-03-03 | 5/250 |
|
|
|
[考研] 307求調(diào)劑 +6 | wyyyqx 2026-03-01 | 6/300 |
|
|
|
[考研] 085600材料工程一志愿中科大總分312求調(diào)劑 +9 | 吃宵夜1 2026-02-28 | 11/550 |
|
|
|
[考研] 材料工程274求調(diào)劑 +5 | Lilithan 2026-03-01 | 5/250 |
|
|
|
[考研] 284求調(diào)劑 +10 | 天下熯 2026-02-28 | 11/550 |
|
|
|
[論文投稿]
求助coordination chemistry reviews 的寫作模板
 10+3
|
ljplijiapeng 2026-02-27 | 4/200 |
|