diff --git a/src/csf/configuration_CI_sigma_helpers.irp.f b/src/csf/configuration_CI_sigma_helpers.irp.f index a4aa41ff..1a8c1d14 100644 --- a/src/csf/configuration_CI_sigma_helpers.irp.f +++ b/src/csf/configuration_CI_sigma_helpers.irp.f @@ -31,9 +31,9 @@ use bitmasks integer :: ndiffDOMO integer :: nxordiffSOMODOMO integer :: ndiffAll - integer :: i - integer :: j - integer :: k + integer :: i,ii + integer :: j,jj + integer :: k,kk integer :: kstart integer :: kend integer :: Nsomo_I @@ -55,13 +55,15 @@ use bitmasks Icfg = psi_configuration(:,:,idxI) - Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1)) - Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2)) + Isomo = iand(act_bitmask(1,1),Icfg(1,1)) + Idomo = iand(act_bitmask(1,1),Icfg(1,2)) ! find out all pq holes possible nholes = 0 ! holes in SOMO - do i = 1,mo_num + !do i = 1,mo_num + do ii = 1,n_act_orb + i = list_act(ii) if(POPCNT(IAND(Isomo,IBSET(0_8,i-1))) .EQ. 1) then nholes += 1 listholes(nholes) = i @@ -69,7 +71,9 @@ use bitmasks endif end do ! holes in DOMO - do i = 1,mo_num + !do i = 1,mo_num + do ii = 1,n_act_orb + i = list_act(ii) if(POPCNT(IAND(Idomo,IBSET(0_8,i-1))) .EQ. 1) then nholes += 1 listholes(nholes) = i @@ -81,7 +85,9 @@ use bitmasks listvmos = -1 vmotype = -1 nvmos = 0 - do i = 1,mo_num + !do i = 1,mo_num + do ii = 1,n_act_orb + i = list_act(ii) if(IAND(Idomo,(IBSET(0_8,i-1))) .EQ. 0) then if(IAND(Isomo,(IBSET(0_8,i-1))) .EQ. 0) then nvmos += 1 @@ -98,8 +104,8 @@ use bitmasks tableUniqueAlphas = .FALSE. ! Now find the allowed (p,q) excitations - Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1)) - Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2)) + Isomo = iand(act_bitmask(1,1),Icfg(1,1)) + Idomo = iand(act_bitmask(1,1),Icfg(1,2)) Nsomo_I = POPCNT(Isomo) if(Nsomo_I .EQ. 0) then kstart = 1 @@ -239,10 +245,10 @@ use bitmasks Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2)) kstart = max(1,cfg_seniority_index(max(0,Nsomo_I-2))) do k = kstart, idxI-1 - diffSOMO = IEOR(Isomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,1,k))) + diffSOMO = IEOR(Isomo,iand(act_bitmask(1,1),psi_configuration(1,1,k))) ndiffSOMO = POPCNT(diffSOMO) if (ndiffSOMO /= 2) cycle - diffDOMO = IEOR(Idomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,2,k))) + diffDOMO = IEOR(Idomo,iand(act_bitmask(1,1),psi_configuration(1,2,k))) xordiffSOMODOMO = IEOR(diffSOMO,diffDOMO) ndiffDOMO = POPCNT(diffDOMO) nxordiffSOMODOMO = POPCNT(xordiffSOMODOMO) @@ -298,9 +304,9 @@ END_PROVIDER integer :: ndiffDOMO integer :: nxordiffSOMODOMO integer :: ndiffAll - integer :: i - integer :: j - integer :: k + integer :: i, ii + integer :: j, jj + integer :: k, kk integer :: kstart integer :: kend integer :: Nsomo_I @@ -311,8 +317,8 @@ END_PROVIDER logical :: pqAlreadyGenQ logical :: pqExistsQ logical :: ppExistsQ - Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1)) - Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2)) + Isomo = iand(act_bitmask(1,1),Icfg(1,1)) + Idomo = iand(act_bitmask(1,1),Icfg(1,2)) !print*,"Input cfg" !call debug_spindet(Isomo,1) !call debug_spindet(Idomo,1) @@ -322,7 +328,9 @@ END_PROVIDER ! find out all pq holes possible nholes = 0 ! holes in SOMO - do i = 1,mo_num + !do i = 1,mo_num + do ii = 1,n_act_orb + i = list_act(ii) if(POPCNT(IAND(Isomo,IBSET(0_8,i-1))) .EQ. 1) then nholes += 1 listholes(nholes) = i @@ -330,7 +338,9 @@ END_PROVIDER endif end do ! holes in DOMO - do i = 1,mo_num + !do i = 1,mo_num + do ii = 1,n_act_orb + i = list_act(ii) if(POPCNT(IAND(Idomo,IBSET(0_8,i-1))) .EQ. 1) then nholes += 1 listholes(nholes) = i @@ -342,7 +352,9 @@ END_PROVIDER listvmos = -1 vmotype = -1 nvmos = 0 - do i = 1,mo_num + !do i = 1,mo_num + do ii = 1,n_act_orb + i = list_act(ii) !print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) if(POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) .EQ. 0) then nvmos += 1 @@ -363,8 +375,8 @@ END_PROVIDER tableUniqueAlphas = .FALSE. ! Now find the allowed (p,q) excitations - Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1)) - Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2)) + Isomo = iand(act_bitmask(1,1),Icfg(1,1)) + Idomo = iand(act_bitmask(1,1),Icfg(1,2)) Nsomo_I = POPCNT(Isomo) if(Nsomo_I .EQ. 0) then kstart = 1 @@ -430,10 +442,10 @@ END_PROVIDER pqAlreadyGenQ = .FALSE. ! First check if it can be generated before do k = kstart, kend - diffSOMO = IEOR(Jsomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,1,k))) + diffSOMO = IEOR(Jsomo,iand(act_bitmask(1,1),psi_configuration(1,1,k))) ndiffSOMO = POPCNT(diffSOMO) if((ndiffSOMO .NE. 0) .AND. (ndiffSOMO .NE. 2)) cycle - diffDOMO = IEOR(Jdomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,2,k))) + diffDOMO = IEOR(Jdomo,iand(act_bitmask(1,1),psi_configuration(1,2,k))) xordiffSOMODOMO = IEOR(diffSOMO,diffDOMO) ndiffDOMO = POPCNT(diffDOMO) nxordiffSOMODOMO = POPCNT(xordiffSOMODOMO) @@ -534,11 +546,11 @@ END_PROVIDER ! Check if this Icfg has been previously generated as a mono ppExistsQ = .False. - Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1)) - Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2)) + Isomo = iand(act_bitmask(1,1),Icfg(1,1)) + Idomo = iand(act_bitmask(1,1),Icfg(1,2)) do k = 1, idxI-1 - diffSOMO = IEOR(Isomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,1,k))) - diffDOMO = IEOR(Idomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,2,k))) + diffSOMO = IEOR(Isomo,iand(act_bitmask(1,1),psi_configuration(1,1,k))) + diffDOMO = IEOR(Idomo,iand(act_bitmask(1,1),psi_configuration(1,2,k))) xordiffSOMODOMO = IEOR(diffSOMO,diffDOMO) ndiffSOMO = POPCNT(diffSOMO) ndiffDOMO = POPCNT(diffDOMO) diff --git a/src/csf/create_excitations.irp.f b/src/csf/create_excitations.irp.f index 5e94e355..1c59d579 100644 --- a/src/csf/create_excitations.irp.f +++ b/src/csf/create_excitations.irp.f @@ -249,6 +249,7 @@ subroutine generate_all_singles_cfg_with_type(bit_tmp,cfgInp,singles,idxs_single integer(bit_kind) :: Jdet(Nint,2) integer :: i,k, n_singles_ma, i_hole, i_particle, ex_type, addcfg + integer :: ii,kk integer(bit_kind) :: single(Nint,2) logical :: i_ok @@ -257,8 +258,12 @@ subroutine generate_all_singles_cfg_with_type(bit_tmp,cfgInp,singles,idxs_single !TODO !Make list of Somo and Domo for holes !Make list of Unocc and Somo for particles - do i_hole = 1+n_core_orb, n_core_orb + n_act_orb - do i_particle = 1+n_core_orb, n_core_orb + n_act_orb + !do i_hole = 1+n_core_orb, n_core_orb + n_act_orb + do ii = 1, n_act_orb + i_hole = list_act(ii) + !do i_particle = 1+n_core_orb, n_core_orb + n_act_orb + do kk = 1, n_act_orb + i_particle = list_act(kk) if(i_hole .EQ. i_particle) cycle addcfg = -1 call do_single_excitation_cfg_with_type(cfgInp,single,i_hole,i_particle,ex_type,i_ok) diff --git a/src/csf/obtain_I_foralpha.irp.f b/src/csf/obtain_I_foralpha.irp.f index d6fbe386..a13fc5da 100644 --- a/src/csf/obtain_I_foralpha.irp.f +++ b/src/csf/obtain_I_foralpha.irp.f @@ -33,7 +33,7 @@ subroutine obtain_connected_J_givenI(idxI, givenI, connectedI, idxs_connectedI, integer :: ndiffSOMO integer :: ndiffDOMO integer :: nxordiffSOMODOMO - integer :: ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes + integer :: iii,ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes integer :: listholes(mo_num) integer :: holetype(mo_num) integer :: end_index @@ -146,7 +146,9 @@ subroutine obtain_connected_J_givenI(idxI, givenI, connectedI, idxs_connectedI, ! holes in SOMO Isomo = psi_configuration(1,1,i) Idomo = psi_configuration(1,2,i) - do ii = 1,mo_num + !do ii = 1,mo_num + do iii = 1,n_act_orb + ii = list_act(iii) if(POPCNT(IAND(Isomo,IBSET(0_8,ii-1))) .EQ. 1) then nholes += 1 listholes(nholes) = ii @@ -154,7 +156,9 @@ subroutine obtain_connected_J_givenI(idxI, givenI, connectedI, idxs_connectedI, endif end do ! holes in DOMO - do ii = 1,mo_num + !do ii = 1,mo_num + do iii = 1,n_act_orb + ii = list_act(iii) if(POPCNT(IAND(Idomo,IBSET(0_8,ii-1))) .EQ. 1) then nholes += 1 listholes(nholes) = ii @@ -204,7 +208,7 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI integer :: ndiffSOMO integer :: ndiffDOMO integer :: nxordiffSOMODOMO - integer :: ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes + integer :: iii,ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes integer :: listholes(mo_num) integer :: holetype(mo_num) integer :: end_index @@ -335,7 +339,9 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI ! holes in SOMO Isomo = psi_configuration(1,1,i) Idomo = psi_configuration(1,2,i) - do ii = 1,mo_num + !do ii = 1,mo_num + do iii = 1,n_act_orb + ii = list_act(iii) if(POPCNT(IAND(Isomo,IBSET(0_8,ii-1))) .EQ. 1) then nholes += 1 listholes(nholes) = ii @@ -343,7 +349,9 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI endif end do ! holes in DOMO - do ii = 1,mo_num + !do ii = 1,mo_num + do iii = 1,n_act_orb + ii = list_act(iii) if(POPCNT(IAND(Idomo,IBSET(0_8,ii-1))) .EQ. 1) then nholes += 1 listholes(nholes) = ii diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 60865320..4420faec 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -810,7 +810,7 @@ subroutine calculate_preconditioner_cfg(diag_energies) ! the configurations in psi_configuration ! returns : diag_energies : END_DOC - integer :: i,j,k,l,p,q,noccp,noccq, ii, jj + integer :: i,j,k,kk,l,p,q,noccp,noccq, ii, jj real*8,intent(out) :: diag_energies(n_CSF) integer :: nholes integer :: nvmos @@ -838,16 +838,19 @@ subroutine calculate_preconditioner_cfg(diag_energies) real*8 :: meCC real*8 :: ecore - PROVIDE h_core_ri + !PROVIDE h_core_ri + PROVIDE core_fock_operator + PROVIDE h_act_ri ! initialize energies diag_energies = 0.d0 + !print *,"Core energy=",core_energy," nucler rep=",nuclear_repulsion, " n_core_orb=",n_core_orb," n_act_orb=",n_act_orb," mo_num=",mo_num ! calculate core energy !call get_core_energy(ecore) - !diag_energies = ecore + diag_energies = core_energy - nuclear_repulsion ! calculate the core energy - !print *,"Core energy=",ref_bitmask_energy + !print *,"Core 2energy=",ref_bitmask_energy do i=1,N_configuration @@ -863,8 +866,9 @@ subroutine calculate_preconditioner_cfg(diag_energies) ! find out all pq holes possible nholes = 0 ! holes in SOMO - !do k = n_core_orb+1,n_core_orb + n_act_orb - do k = 1,mo_num + !do k = 1,mo_num + do kk = 1,n_act_orb + k = list_act(kk) if(POPCNT(IAND(Isomo,IBSET(0_8,k-1))) .EQ. 1) then nholes += 1 listholes(nholes) = k @@ -874,7 +878,9 @@ subroutine calculate_preconditioner_cfg(diag_energies) ! holes in DOMO !do k = n_core_orb+1,n_core_orb + n_act_orb !do k = 1+n_core_inact_orb,n_core_orb+n_core_inact_act_orb - do k = 1,mo_num + !do k = 1,mo_num + do kk = 1,n_act_orb + k = list_act(kk) if(POPCNT(IAND(Idomo,IBSET(0_8,k-1))) .EQ. 1) then nholes += 1 listholes(nholes) = k @@ -887,7 +893,9 @@ subroutine calculate_preconditioner_cfg(diag_energies) vmotype = -1 nvmos = 0 !do k = n_core_orb+1,n_core_orb + n_act_orb - do k = 1,mo_num + !do k = 1,mo_num + do kk = 1,n_act_orb + k = list_act(kk) !print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) if(POPCNT(IAND(Isomo,(IBSET(0_8,k-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,k-1)))) .EQ. 0) then nvmos += 1 @@ -916,7 +924,7 @@ subroutine calculate_preconditioner_cfg(diag_energies) ! one-electron term if(p.EQ.q) then - hpp = noccq * h_core_ri(p,q)!mo_one_e_integrals(q,q) + hpp = noccq * h_act_ri(p,q)!mo_one_e_integrals(q,q) else hpp = 0.d0 endif @@ -1295,7 +1303,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze real*8,intent(in) :: psi_in(n_st,sze) real*8,intent(out) :: psi_out(n_st,sze) integer(bit_kind) :: Icfg(N_INT,2) - integer :: i,j,k,l,p,q,noccp,noccq, ii, jj, m, n, idxI, kk, nocck,orbk + integer :: i,j,k,l,p,q,noccp,noccq, m, n, idxI, nocck,orbk + integer :: ii,jj,kk,ll,pp,qq integer(bit_kind),dimension(:,:,:),allocatable :: listconnectedJ integer(bit_kind),dimension(:,:,:),allocatable :: alphas_Icfg integer(bit_kind),dimension(:,:,:),allocatable :: singlesI @@ -1394,10 +1403,10 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze !$OMP colsikpq, GIJpqrs,TKIGIJ,j,l,m,TKI,CCmattmp, moi, moj, mok, mol,& !$OMP diagfac, tmpvar, diagfactors_0) & !$OMP shared(istart_cfg, iend_cfg, psi_configuration, mo_num, psi_config_data,& - !$OMP N_int, N_st, psi_out, psi_in, h_core_ri, AIJpqContainer,& + !$OMP N_int, N_st, psi_out, psi_in, h_core_ri, core_energy, h_act_ri, AIJpqContainer,& !$OMP sze, NalphaIcfg_list,alphasIcfg_list, bit_tmp, & !$OMP AIJpqMatrixDimsList, diag_energies, n_CSF, lock, NBFmax,nconnectedtotalmax, nconnectedmaxJ,maxnalphas,& - !$OMP num_threads_max) + !$OMP n_core_orb, n_act_orb, list_act, num_threads_max) allocate(singlesI(N_INT,2,max(sze,10000))) allocate(idxs_singlesI(max(sze,10000))) @@ -1430,8 +1439,9 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze ! list_core ! list_core_inact ! bitmasks - !do k = n_core_orb+1,n_core_orb + n_act_orb - do k = 1,mo_num + !do k = 1,mo_num + do kk = 1,n_act_orb + k = list_act(kk) if(POPCNT(IAND(Isomo,IBSET(0_8,k-1))) .EQ. 1) then nholes += 1 listholes(nholes) = k @@ -1439,8 +1449,9 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze endif enddo ! holes in DOMO - !do k = n_core_orb+1,n_core_orb + n_act_orb - do k = 1,mo_num + !do k = 1,mo_num + do kk = 1,n_act_orb + k = list_act(kk) if(POPCNT(IAND(Idomo,IBSET(0_8,k-1))) .EQ. 1) then nholes += 1 listholes(nholes) = k @@ -1452,8 +1463,9 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze listvmos = -1 vmotype = -1 nvmos = 0 - !do k = n_core_orb+1,n_core_orb + n_act_orb - do k = 1,mo_num + do kk = 1,n_act_orb + !do k = 1,mo_num + k = list_act(kk) !print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) if(POPCNT(IAND(Isomo,(IBSET(0_8,k-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,k-1)))) .EQ. 0) then nvmos += 1 @@ -1507,7 +1519,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze cnti = ii-starti+1 do jj = startj, endj cntj = jj-startj+1 - meCC1 = AIJpqContainer(cnti,cntj,pmodel,qmodel,extype,NSOMOI)* h_core_ri(p,q) + !meCC1 = AIJpqContainer(cnti,cntj,pmodel,qmodel,extype,NSOMOI)* h_core_ri(p,q) + meCC1 = AIJpqContainer(cnti,cntj,pmodel,qmodel,extype,NSOMOI)* h_act_ri(p,q) !print *,"jj = ",jj call omp_set_lock(lock(jj)) do kk = 1,n_st @@ -1532,6 +1545,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze deallocate(excitationIds_single) deallocate(excitationTypes_single) + !print *," psi(60,1)=",psi_out(1,60) + allocate(listconnectedJ(N_INT,2,max(sze,10000))) allocate(alphas_Icfg(N_INT,2,max(sze,10000))) allocate(connectedI_alpha(N_INT,2,max(sze,10000))) @@ -1711,6 +1726,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze !$OMP END PARALLEL call omp_set_max_active_levels(4) + !print *," psi(60,1)=",psi_out(1,60) + !print *," diag_enregy=",diag_energies(1), " psi_out(1,1)=",psi_out(1,1) deallocate(diag_energies) deallocate(bit_tmp) diff --git a/src/mo_two_e_ints/core_quantities.irp.f b/src/mo_two_e_ints/core_quantities.irp.f index b764a1a6..e048f6a6 100644 --- a/src/mo_two_e_ints/core_quantities.irp.f +++ b/src/mo_two_e_ints/core_quantities.irp.f @@ -13,7 +13,19 @@ BEGIN_PROVIDER [double precision, core_energy] core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l)) enddo enddo + !print *," core no nucl=",core_energy + ! core-active + do i = 1, n_core_orb + j = list_core(i) + !!! VJ + !!! TODO: Correct the loop over active electrons + do k = 1, (elec_num - 2*n_core_orb)/2 + l = k + n_core_orb + core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l)) + enddo + enddo core_energy += nuclear_repulsion + !print *," core no nucl=",core_energy END_PROVIDER @@ -59,3 +71,43 @@ BEGIN_PROVIDER [ double precision, h_core_ri, (mo_num, mo_num) ] enddo END_PROVIDER + +BEGIN_PROVIDER [ double precision, h_act_ri, (mo_num, mo_num) ] + implicit none + BEGIN_DOC + ! Active Hamiltonian with 3-index exchange integrals: + ! + ! $\tilde{h}{pq} = h_{pq} - \frac{1}{2}\sum_{k} g(pk,kq)$ + END_DOC + + integer :: i,j, k + integer :: p,q, r + ! core-core contribution + h_act_ri = core_fock_operator + ! act-act contribution + do p=1,n_act_orb + j=list_act(p) + do q=1,n_act_orb + i=list_act(q) + h_act_ri(i,j) = mo_one_e_integrals(i,j) + enddo + do r=1,n_act_orb + k=list_act(r) + do q=1,n_act_orb + i=list_act(q) + h_act_ri(i,j) = h_act_ri(i,j) - 0.5 * big_array_exchange_integrals(k,i,j) + enddo + enddo + enddo + ! core-act contribution + do p=1,n_core_orb + j=list_core(p) + do k=1,mo_num + do q=1,n_act_orb + i=list_act(q) + h_act_ri(i,j) = h_act_ri(i,j) - 0.5 * big_array_exchange_integrals(k,i,j) + enddo + enddo + enddo +END_PROVIDER +